#!/usr/bin/perl
#
# Copyright (c) 2018, 2021  Peter Pentchev
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

use v5.010;
use strict;
use warnings;

use JSON::XS qw(decode_json);
use Test::More;
use Test::Command;

use lib 't/lib';
use Test::FeatureCheck qw(
	env_init
	get_error_output get_ok_output
	test_fcheck_init
);

my %alt_ops = (
	'lt' => '<',
	'le' => '<=',
	'eq' => '=',
	'ge' => '>=',
	'gt' => '>',
);

my @tests = (
	['base lt 2', 0],
	['base le 2', 0],
	['base ge 2', 1],
	['base gt 2', 1],
	['base eq 2', 0],
	['base lt 2.1.a', 0],
	['base le 2.1.a', 0],
	['base ge 2.1.a', 1],
	['base gt 2.1.a', 1],
	['base eq 2.1.a', 0],
	['base lt 2.1', 0],
	['base le 2.1', 1],
	['base ge 2.1', 1],
	['base gt 2.1', 0],
	['base eq 2.1', 1],
	['base lt 2.1a', 1],
	['base le 2.1a', 1],
	['base ge 2.1a', 0],
	['base gt 2.1a', 0],
	['base eq 2.1a', 0],
	['base lt 2.1.0', 1],
	['base le 2.1.0', 1],
	['base ge 2.1.0', 0],
	['base gt 2.1.0', 0],
	['base eq 2.1.0', 0],
	['base lt 2.1.1', 1],
	['base le 2.1.1', 1],
	['base ge 2.1.1', 0],
	['base gt 2.1.1', 0],
	['base eq 2.1.1', 0],
	['base lt 3', 1],
	['base le 3', 1],
	['base ge 3', 0],
	['base gt 3', 0],
	['base eq 3', 0],
	['base lt 10', 1],
	['base le 10', 1],
	['base ge 10', 0],
	['base gt 10', 0],
	['base eq 10', 0],
	['base lt 10.1', 1],
	['base le 10.1', 1],
	['base ge 10.1', 0],
	['base gt 10.1', 0],
	['base eq 10.1', 0],
	['beta lt 1', 0],
	['beta le 1', 0],
	['beta eq 1', 0],
	['beta ge 1', 1],
	['beta gt 1', 1],
	['beta lt 3.0', 1],
	['beta le 3.0', 1],
	['beta eq 3.0', 0],
	['beta ge 3.0', 0],
	['beta gt 3.0', 0],
	['beta lt 3.0.beta1', 0],
	['beta le 3.0.beta1', 0],
	['beta eq 3.0.beta1', 0],
	['beta ge 3.0.beta1', 1],
	['beta gt 3.0.beta1', 1],
	['beta lt 3.0.beta2', 0],
	['beta le 3.0.beta2', 1],
	['beta eq 3.0.beta2', 1],
	['beta ge 3.0.beta2', 1],
	['beta gt 3.0.beta2', 0],
	['beta lt 3.0.beta3', 1],
	['beta le 3.0.beta3', 1],
	['beta eq 3.0.beta3', 0],
	['beta ge 3.0.beta3', 0],
	['beta gt 3.0.beta3', 0],
	['beta lt 3.0.0', 1],
	['beta le 3.0.0', 1],
	['beta eq 3.0.0', 0],
	['beta ge 3.0.0', 0],
	['beta gt 3.0.0', 0],
);

my %c = env_init;

plan tests => 2 + 6 * scalar @tests;

test_fcheck_init \%c;

subtest 'Check for simple feature support' => sub {
	my @lines = get_ok_output([$c{prog}, '--features'], 'get features');
	is scalar @lines, 1, 'list features output a single line';
	BAIL_OUT('No "Features: " on the features line') unless
	    $lines[0] =~ /^ Features: \s (?<features> .* ) $/x;
	my @words = split /\s+/, $+{features};
	my %names = map { split /[:\/=]/, $_, 2 } @words;
	BAIL_OUT('No "simple" in the features list') unless
	    defined $names{'simple'};
	BAIL_OUT('Only know how to test the "simple" feature version 1.x') unless
	    $names{'simple'} =~ m{^ 1 (?: \..* )? $ }x;
};

for my $t (@tests) {
	my ($test, $exp) = @{$t};
	my @words = split /\s+/, $test;
	die "Internal error: test '$test': how many words?\n"
	    unless @words == 3;

	my $alt_op = $alt_ops{$words[1]};
	die "Internal error: no alt op for '$words[1]'\n"
	    unless defined $alt_op;
	my @alt_words = ($words[0], $alt_op, $words[2]);

	subtest "$test" => sub {
		my $cmd = [$c{prog}, $c{fcheck}, $test];
		my @lines;
		if ($exp) {
			@lines = get_ok_output($cmd, $test);
		} else {
			@lines = get_error_output($cmd, $test);
		}
		is scalar @lines, 0, "'$test' output nothing";
	};

	subtest "$test" => sub {
		my $cmd = [$c{prog}, $c{fcheck}, join ' ', @alt_words];
		my @lines;
		if ($exp) {
			@lines = get_ok_output($cmd, $test);
		} else {
			@lines = get_error_output($cmd, $test);
		}
		is scalar @lines, 0, "'$test' output nothing";
	};

	subtest "$test" => sub {
		my $cmd = [$c{prog}, $c{fcheck}, @words];
		my @lines;
		if ($exp) {
			@lines = get_ok_output($cmd, $test);
		} else {
			@lines = get_error_output($cmd, $test);
		}
		is scalar @lines, 0, "'$test' output nothing";
	};

	subtest "$test" => sub {
		my $cmd = [$c{prog}, $c{fcheck}, @alt_words];
		my @lines;
		if ($exp) {
			@lines = get_ok_output($cmd, $test);
		} else {
			@lines = get_error_output($cmd, $test);
		}
		is scalar @lines, 0, "'$test' output nothing";
	};

	subtest "$test" => sub {
		my $cmd = [$c{prog}, $c{fcheck},
		    $words[0], "$words[1] $words[2]"];
		my @lines;
		if ($exp) {
			@lines = get_ok_output($cmd, $test);
		} else {
			@lines = get_error_output($cmd, $test);
		}
		is scalar @lines, 0, "'$test' output nothing";
	};

	subtest "$test" => sub {
		my $cmd = [$c{prog}, $c{fcheck},
		    $alt_words[0], "$alt_words[1] $alt_words[2]"];
		my @lines;
		if ($exp) {
			@lines = get_ok_output($cmd, $test);
		} else {
			@lines = get_error_output($cmd, $test);
		}
		is scalar @lines, 0, "'$test' output nothing";
	};
}
