# t/TestSD.pm #

#   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
#   Copyright © 2015 Van de Bugger
#
#   This file is part of perl-Systemd-Daemon.
#
#   perl-Systemd-Daemon is free software: you can redistribute it and/or modify it under the terms
#   of the GNU General Public License as published by the Free Software Foundation, either version
#   3 of the License, or (at your option) any later version.
#
#   perl-Systemd-Daemon is distributed in the hope that it will be useful, but WITHOUT ANY
#   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
#   PURPOSE. See the GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License along with
#   perl-Systemd-Daemon. If not, see <http://www.gnu.org/licenses/>.
#
#   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

package TestSD;

use strict;
use warnings;

use parent 'Test::Builder::Module';
use POSIX qw{};

our $CLASS = __PACKAGE__;
our @EXPORT = qw{
    %Funcs @Funcs $Funcs
    test_use
    test_func_is_imported
    test_func_is_not_imported
    test_import_none
    test_import_some
    test_import_all
    test_call_func_no_args
    test_call_func
};

my $stub = - POSIX::ENOSYS;     # Stub functions return this error.

our %Funcs = (
    # Key   — function name.
    # args  — array of arguments to pass to a function.
    # XS    — expected result from XS implementation.
    # Stub  — Expected result from Stub implementation.
    sd_listen_fds          => { args => [ 0 ],         XS => 0,              Stub => $stub },
    sd_notify              => { args => [ ( 0 ) x 2 ], XS => 0,              Stub => $stub },
    sd_pid_notify          => { args => [ ( 0 ) x 3 ], XS => 0,              Stub => $stub },
    #~ sd_pid_notify_with_fds =>args =>  5,
    sd_booted              => { args => [],            XS => 1,              Stub => $stub },
    sd_is_fifo             => { args => [ ( 0 ) x 2 ], XS => 0,              Stub => $stub },
    sd_is_socket           => { args => [ ( 0 ) x 4 ], XS => 0,              Stub => $stub },
    #~ sd_is_socket_inet      =>args =>  5,
    sd_is_socket_unix      => { args => [ ( 0 ) x 6 ], XS => 0,              Stub => $stub },
    sd_is_mq               => { args => [ ( 0 ) x 2 ], XS => - POSIX::EBADF, Stub => $stub },
    sd_is_special          => { args => [ ( 0 ) x 2 ], XS => 0,              Stub => $stub },
    #~ sd_watchdog_enabled    =>args =>  2,
    SD_EMERG               => { args => [],            XS => "<0>",          Stub => "<0>" },
    SD_ALERT               => { args => [],            XS => "<1>",          Stub => "<1>" },
    SD_CRIT                => { args => [],            XS => "<2>",          Stub => "<2>" },
    SD_ERR                 => { args => [],            XS => "<3>",          Stub => "<3>" },
    SD_WARNING             => { args => [],            XS => "<4>",          Stub => "<4>" },
    SD_NOTICE              => { args => [],            XS => "<5>",          Stub => "<5>" },
    SD_INFO                => { args => [],            XS => "<6>",          Stub => "<6>" },
    SD_DEBUG               => { args => [],            XS => "<7>",          Stub => "<7>" },
);
our @Funcs = keys( %Funcs );    # Array of function names.
our $Funcs = @Funcs;            # Number of functions.

sub test_use($$@) {
    my ( $package, $module, @import ) = @_;
    my $tb = $CLASS->builder();
    my $use = "use $module qw{ " . join( ' ', @import ) . " }";
    local $@;
    eval "package $package; $use;";
    return $tb->is_eq( $@, '', $use );
};

sub test_func_is_imported($$) {
    my ( $pkg, $name ) = @_;
    my $tb = $CLASS->builder();
    local $@;
    eval sprintf( '%s::%s();', $pkg, $name );         # Call a function with no arguments.
    if ( @{ $Funcs{ $name }->{ args } } ) {
        # Function with parameters will complain.
        return $tb->like( $@, qr{^Not enough arguments for|^Usage: }, "$name is imported to $pkg" );
    } else {
        # Function with no parameters will not throw exceptions.
        return $tb->is_eq( $@, '', "$name is imported to $pkg" );
    };
};

sub test_func_is_not_imported($$) {
    my ( $pkg, $name ) = @_;
    my $tb = $CLASS->builder();
    local $@;
    eval sprintf( '%s::%s();', $pkg, $name );     # Call a function with no arguments.
    return $tb->like( $@, qr{^Undefined subroutine &${pkg}::${name} called}, "$name is not imported to $pkg" );
};

sub test_call_func_no_args($$) {
    my ( $pkg, $name ) = @_;
    my $tb = $CLASS->builder();
    local $@;
    eval sprintf( '%s::%s();', $pkg, $name );
    if ( @{ $Funcs{ $name }->{ args } } ) {
        return $tb->like( $@, qr{^Not enough arguments for|^Usage: }, "$name is defined in $pkg" );
    } else {
        return $tb->is_eq( $@, '', "$name is defined in $pkg" );
    };
};

sub test_call_func($$) {
    my ( $pkg, $name ) = @_;
    my $tb = $CLASS->builder();
    my $func = $Funcs{ $name };
    my $call = sprintf( '%s::%s( %s )', $pkg, $name, join( ', ', @{ $func->{ args } } ) );
    my $exp  = $func->{ do { ( $_ = $pkg ) =~ s{^.*::}{}; $_; } };
    return $tb->subtest( "call $name", sub {
        $tb->plan( tests => 2 );
        my $rc;
        local $@;
        eval "\$rc = $call;";
        $tb->is_eq( $@, '', 'no exceptions' ) or return;
        $tb->is_eq( $rc, $exp, 'result' );
        $tb->done_testing();
    } );
};

sub test_import_none($$) {
    my ( $pkg, $module ) = @_;
    my $tb = $CLASS->builder();
    return $tb->subtest( 'import none', sub {
        $tb->plan( tests => 1 + $Funcs );
        my $use = test_use( $pkg, $module );
        foreach my $f ( @Funcs ) {
            if ( $use ) {
                test_func_is_not_imported( $pkg, $f );
            } else {
                $tb->skip( 'use failed' );
            };
        };
        $tb->done_testing();
    } );
};

sub test_import_some($$@) {
    my ( $pkg, $module, @import ) = @_;
    my $tb = $CLASS->builder();
    return $tb->subtest( 'import some', sub {
        $tb->plan( tests => 1 + $Funcs );
        my $use = test_use( $pkg, $module, @import );
        foreach my $f ( @Funcs ) {
            if ( $use ) {
                if ( grep( $_ eq $f, @import ) ) {
                    test_func_is_imported( $pkg, $f );
                } else {
                    test_func_is_not_imported( $pkg, $f );
                };
            } else {
                $tb->skip( 'use failed' );
            };
        };
        $tb->done_testing();
    } );
};

sub test_import_all($$) {
    my ( $pkg, $module ) = @_;
    my $tb = $CLASS->builder();
    return $tb->subtest( 'import all', sub {
        $tb->plan( tests => 1 + $Funcs );
        my $use = test_use( $pkg, $module, ':all' );
        foreach my $f ( @Funcs ) {
            if ( $use ) {
                test_func_is_imported( $pkg, $f );
            } else {
                $tb->skip( 'use failed' );
            };
        };
        $tb->done_testing();
    } );
};

1;
