#!/usr/bin/perl

use 5.010;
use strict;
use warnings FATAL => 'all';
use FindBin '$Bin';

use vars qw($VERSION);
use Data::Clone;
use File::Slurp;
use YAML::Syck qw(Dump);

# VERSION
unless (defined $VERSION) {
    my $dist = read_file "$Bin/../dist.ini";
    $dist =~ /^\s*version\s*=\s*(.+)/m and $VERSION = $1;
}

our ($Type, $Clause);

# describe literal
sub _l {
    my $d = shift;
    return "undefined value" if !defined($d);
    return $d unless ref($d);
    my $res = Dump($_);
    $res =~ s/\s+\z//s;
    $res;
}

sub gen_type_check_tests {
    my %args = @_;
    my @res;

    for (@{ $args{accept} }) {
        push @res, {
            name   => "type check: must accept "._l($_),
            input  => $_,
            schema => $Type,
            valid  => 1,
        };
    }
    for (@{ $args{reject} }) {
        push @res, {
            name   => "type check: must reject "._l($_),
            input  => $_,
            schema => $Type,
            valid  => 0,
        };
    }

    @res;
}

# req, forbidden, default
sub gen_BaseType_tests {
    my %args = @_;
    my @res;

    push @res, {
        name   => "must accept undefined value",
        schema => $Type,
        input  => undef,
        valid  => 1,
    };

    # req
    push @res, {
        name   => "req=0 must accept undefined value",
        schema => [$Type, req=>0],
        input  => undef,
        valid  => 1,
    };
    push @res, {
        name   => "req=1 must reject undefined value",
        schema => [$Type, req=>1],
        input  => undef,
        valid  => 0,
    };

    # forbidden
    push @res, {
        name   => "forbidden=0 must accept defined value",
        schema => [$Type, forbidden=>0],
        input  => $args{value},
        valid  => 1,
    };
    push @res, {
        name   => "forbidden=1 must reject defined value",
        schema => [$Type, forbidden=>1],
        input  => $args{value},
        valid  => 0,
    };

    # default
    for (@{ $args{ok_defaults} }) {
        push @res, {
            name   => "default: must accept valid default "._l($_),
            input  => undef,
            schema => ["$Type*", default=>$_],
            valid  => 1,
        };
    }
    for (@{ $args{nok_defaults} }) {
        push @res, {
            name   => "default: must reject invalid default "._l($_),
            input  => undef,
            schema => ["$Type*", default=>$_],
            valid  => 0,
        };
    }

    @res;
}

sub gen_multi_cval_tests {
    my %args = @_;
    my @res;

    die "BUG: Need at least 2 values for ok_values"
        unless @{$args{ok_values}}>1;
    die "BUG: Need at least 2 values for nok_values"
        unless @{$args{nok_values}}>1;

    push @res, {
        name  => "!$Clause: (nok)",
        input => $args{input},
        schema => [$Type, "!$Clause" => $args{ok_values}[0]],
        valid  => 0,
    };
    push @res, {
        name  => "!$Clause: (ok)",
        input => $args{input},
        schema => [$Type, "!$Clause" => $args{nok_values}[0]],
        valid  => 1,
    };

    push @res, {
        name  => "$Clause&: (no items)",
        input => $args{input},
        schema => [$Type, "$Clause&" => []],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause&: (ok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause&" => $args{ok_values}],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause&: (nok + ok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause&" => [$args{nok_values}[0], $args{ok_values}[0]]],
        valid  => 0,
        errors => 1,
    };
    push @res, {
        name  => "$Clause&: (ok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause&" => [$args{ok_values}[0], $args{nok_values}[0]]],
        valid  => 0,
        errors => 1,
    };
    push @res, {
        name  => "$Clause&: (nok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause&" => [$args{nok_values}[0], $args{nok_values}[1]]],
        valid  => 0,
        errors => 2,
    };

    push @res, {
        name  => "$Clause|: (no items)",
        input => $args{input},
        schema => [$Type, "$Clause|" => []],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause|: (ok)",
        input => $args{input},
        schema => [$Type, "$Clause|" => $args{ok_values}],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause|: (nok + ok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause|" => [$args{nok_values}[0], $args{ok_values}[0]]],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause|: (ok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause|" => [$args{ok_values}[0], $args{nok_values}[0]]],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause|: (nok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause|" => [$args{nok_values}[0], $args{nok_values}[1]]],
        valid  => 0,
        errors => 1,
    };

    push @res, {
        name  => "$Clause.min_ok (nok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{nok_values}[0], $args{nok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.min_ok" => 1],
        valid  => 0,
    };
    push @res, {
        name  => "$Clause.min_ok (ok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{ok_values}[0], $args{nok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.max_ok" => 1],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause.min_ok (ok + ok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{ok_values}[0], $args{ok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.min_ok" => 1],
        valid  => 1,
    };

    push @res, {
        name  => "$Clause.max_ok (nok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{nok_values}[0], $args{nok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.max_ok" => 1],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause.max_ok (ok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{ok_values}[0], $args{nok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.max_ok" => 1],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause.max_ok (ok + ok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{ok_values}[0], $args{ok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.max_ok" => 1],
        valid  => 0,
    };

    push @res, {
        name  => "$Clause.min_nok (nok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{nok_values}[0], $args{nok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.min_nok" => 1],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause.min_nok (ok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{ok_values}[0], $args{nok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.min_nok" => 1],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause.min_nok (ok + ok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{ok_values}[0], $args{ok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.min_nok" => 1],
        valid  => 0,
    };

    push @res, {
        name  => "$Clause.max_nok (nok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{nok_values}[0], $args{nok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.max_nok" => 1],
        valid  => 0,
    };
    push @res, {
        name  => "$Clause.max_nok (ok + nok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{ok_values}[0], $args{nok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.max_nok" => 1],
        valid  => 1,
    };
    push @res, {
        name  => "$Clause.max_nok (ok + ok)",
        input => $args{input},
        schema => [$Type,
                   "$Clause" => [$args{ok_values}[0], $args{ok_values}[1]],
                   "$Clause.is_multi" => 1, "$Clause.max_nok" => 1],
        valid  => 1,
    };

    @res;
}

sub gen_err_level_tests {
    my %args = @_;
    (
        {
            name   => ".err_level=error (clause=$args{clause}, ok)",
            input  => $args{ok_value},
            schema => [$Type, $args{clause} => $args{cval}],
            valid  => 1,
        },
        {
            name   => ".err_level=error (clause=$args{clause}, nok)",
            input  => $args{nok_value},
            schema => [$Type, $args{clause} => $args{cval}],
            valid  => 0,
        },
        {
            name   => ".err_level=warn (clause=$args{clause}, ok)",
            input  => $args{ok_value},
            schema => [$Type, $args{clause} => $args{cval},
                       "$args{clause}.err_level"=>"warn"],
            valid  => 1,
        },
        {
            name   => ".err_level=warn (clause=$args{clause}, nok)",
            input  => $args{nok_value},
            schema => ["$Type*", $args{clause} => $args{cval},
                       "$args{clause}.err_level"=>"warn"],
            valid  => 1,
            warnings => 1,
        },
    );
    # XXX .err_level=fatal (needs two clauses)
}

sub gen_Comparable_tests {
    my %args = @_;
    my @res;

    my $v  = $args{values}[0];
    my $v2 = $args{values}[1];

    # is
    push @res, {
        name   => "is: must accept same value",
        schema => [$Type, is=>$v],
        input  => $v,
        valid  => 1,
    };
    push @res, {
        name   => "is: must reject different value",
        schema => [$Type, is=>$v2],
        input  => $v,
        valid  => 0,
    };
    local $Clause = "is";
    push @res, gen_multi_cval_tests(
        input      => $v,
        ok_values  => [$v, $v],
        nok_values => [$v2, $v2],
    );

    # in
    push @res, {
        name   => "in: must accept valid choices",
        schema => [$Type, in=>$args{values}],
        input  => $v,
        valid  => 1,
    };
    push @res, {
        name   => "in: must reject empty choices",
        schema => [$Type, in=>[]],
        input  => $v,
        valid  => 0,
    };
    local $Clause = "in";
    push @res, gen_multi_cval_tests(
        input      => $v,
        ok_values  => [$args{values}, clone($args{values})],
        nok_values => [[], []],
    );

    @res;
}

sub gen_Sortable_tests {
    my %args = @_;
    my @res;

    die "BUG: Please supply 3 values" unless @{ $args{values} } == 3;

    # $v2 must be > $v1, and $v3 must be >= $v2
    my ($v1, $v2, $v3) = @{ $args{values} };

    push @res, (

        {
            name   => "min: "._l($v2)." "._l($v1),
            input  => $v2,
            schema => [$Type, min => $v1],
            valid  => 1,
        },
        {
            name   => "min: "._l($v2)." "._l($v2),
            input  => $v2,
            schema => [$Type, min => $v2],
            valid  => 1,
        },
        {
            name   => "min: "._l($v1)." "._l($v2).' -> fail',
            input  => $v1,
            schema => [$Type, min => $v2],
            valid  => 0,
        },

        {
            name   => "xmin: "._l($v2)." "._l($v1),
            input  => $v2,
            schema => [$Type, xmin => $v1],
            valid  => 1,
        },
        {
            name   => "xmin: "._l($v2)." "._l($v2).' -> fail',
            input  => $v2,
            schema => [$Type, xmin => $v2],
            valid  => 0,
        },
        {
            name   => "xmin: "._l($v1)." "._l($v2).' -> fail',
            input  => $v1,
            schema => [$Type, xmin => $v2],
            valid  => 0,
        },

        {
            name   => "max: "._l($v2)." "._l($v1).' -> fail',
            input  => $v2,
            schema => [$Type, max => $v1],
            valid  => 0,
        },
        {
            name   => "max: "._l($v2)." "._l($v2),
            input  => $v2,
            schema => [$Type, max => $v2],
            valid  => 1,
        },
        {
            name   => "max: "._l($v1)." "._l($v2),
            input  => $v1,
            schema => [$Type, max => $v2],
            valid  => 1,
        },

        {
            name   => "xmax: "._l($v2)." "._l($v1).' -> fail',
            input  => $v2,
            schema => [$Type, xmax => $v1],
            valid  => 0,
        },
        {
            name   => "xmax: "._l($v2)." "._l($v2).' -> fail',
            input  => $v2,
            schema => [$Type, xmax => $v2],
            valid  => 0,
        },
        {
            name   => "xmax: "._l($v1)." "._l($v2),
            input  => $v1,
            schema => [$Type, xmax => $v2],
            valid  => 1,
        },

        {
            name   => "between: "._l($v2)." "._l($v1)." & "._l($v3),
            input  => $v2,
            schema => [$Type, between => [$v1, $v3]],
            valid  => 1,
        },
        {
            name   => "between: "._l($v2)." "._l($v1)." & "._l($v2),
            input  => $v2,
            schema => [$Type, between => [$v1, $v2]],
            valid  => 1,
        },
        {
            name   => "between: "._l($v2)." "._l($v2)." & "._l($v2),
            input  => $v2,
            schema => [$Type, between => [$v2, clone($v2)]],
            valid  => 1,
        },
        {
            name   => "between: "._l($v1)." "._l($v2)." & "._l($v3).' -> fail',
            input  => $v1,
            schema => [$Type, between => [$v2, $v3]],
            valid  => 0,
        },

        {
            name   => "xbetween: "._l($v2)." "._l($v1)." & "._l($v3),
            input  => $v2,
            schema => [$Type, xbetween => [$v1, $v3]],
            valid  => $v3 eq $v2 ? 0:1,
        },
        {
            name   => "xbetween: "._l($v2)." "._l($v1)." & "._l($v2).' -> fail',
            input  => $v2,
            schema => [$Type, xbetween => [$v1, $v2]],
            valid  => 0,
        },
        {
            name   => "xbetween: "._l($v2)." "._l($v2)." & "._l($v2).' -> fail',
            input  => $v2,
            schema => [$Type, xbetween => [$v2, clone($v2)]],
            valid  => 0,
        },
        {
            name   => "xbetween: "._l($v1)." "._l($v2)." & "._l($v3).' -> fail',
            input  => $v1,
            schema => [$Type, xbetween => [$v2, $v3]],
            valid  => 0,
        },

    );

    # disabled temporarily because failing for bool, even though i've adjust
    # ok_values & nok_values
    #local $Clause = "between";
    #push @res, gen_multi_cval_tests(
    #    input      => $v1,
    #    # i know, lame, it's because bool only has two possible values
    #    ok_values  => [[$v1, clone($v1)], [$v1, clone($v1)]],
    #    nok_values => [[$v2, clone($v2)], [$v2, clone($v2)]],
    #);

    # XXX multi cval for xbetween

    @res;
}

sub gen_HasElems_tests {
    my %args = @_;
    my @res;

    die "BUG: Please supply two values" unless @{$args{values}} == 2;

    my $v1 = $args{values}[0][0];
    my $l1 = $args{values}[0][1];
    my $v2 = $args{values}[1][0];
    my $l2 = $args{values}[1][1];

    die "BUG: First value's length must be less than second value's"
        unless $l1 < $l2;

    push @res, (
        {
            name   => "len (ok)",
            input  => $v1,
            schema => [$Type, len => $l1],
            valid  => 1,
        },
        {
            name   => "len (nok)",
            input  => $v1,
            schema => [$Type, len => $l2],
            valid  => 0,
        },
        {
            name   => "min_len (ok)",
            input  => $v1,
            schema => [$Type, min_len => $l1],
            valid  => 1,
        },
        {
            name   => "min_len (nok)",
            input  => $v1,
            schema => [$Type, min_len => $l2],
            valid  => 0,
        },
        {
            name   => "max_len (ok)",
            input  => $v1,
            schema => [$Type, min_len => $l1],
            valid  => 1,
        },
        {
            name   => "max_len (nok)",
            input  => $v2,
            schema => [$Type, max_len => $l1],
            valid  => 0,
        },
        {
            name   => "len_between (ok)",
            input  => $v1,
            schema => [$Type, len_between => [$l1, $l2]],
            valid  => 1,
        },
        {
            name   => "len_between (nok)",
            input  => $v2,
            schema => [$Type, len_between => [$l1, $l1]],
            valid  => 0,
        },

        # XXX has

        {
            name   => "each_index (ok)",
            input  => $v2,
            schema => [$Type, each_index => $args{ok_each_index}],
            valid  => 1,
        },
        {
            name   => "each_index (nok)",
            input  => $v2,
            schema => [$Type, each_index => $args{nok_each_index}],
            valid  => 0,
        },
        {
            name   => "each_elem (ok)",
            input  => $v2,
            schema => [$Type, each_elem => $args{ok_each_elem}],
            valid  => 1,
        },
        {
            name   => "each_elem (nok)",
            input  => $v2,
            schema => [$Type, each_elem => $args{nok_each_elem}],
            valid  => 0,
        },

        # XXX check_each_index
        # XXX check_each_elem
        # XXX uniq
        # XXX exists
    );

    # XXX multi vals for all clauses

    @res;
}

sub gen_int_tests {
    my %args = @_;
    my @res;

    local $Type = "int";

    (
        gen_type_check_tests(
            accept => [-1, 0, 1],
            reject => [1.1, "a", [], {}], # XXX -Inf, NaN, Inf
        ),
        gen_BaseType_tests(
            value => 2,
            ok_defaults  => [1],
            nok_defaults => [[]],
        ),
        gen_err_level_tests(
            clause    => 'div_by',
            cval      => 3,
            ok_value  => 9,
            nok_value => 8,
        ),
        gen_Comparable_tests(
            values => [1, 2],
        ),
        gen_Sortable_tests(
            values => [-3, 2, 4],
        ),

        {
            name   => 'mod: (nok)',
            input  => 10,
            schema => [int => mod => [3, 2]],
            valid  => 0,
        },
        {
            name   => 'mod: (ok)',
            input  => 11,
            schema => [int => mod => [3, 2]],
            valid  => 1,
        },

        {
            name   => 'div_by: (nok)',
            input  => 7,
            schema => [int => div_by => 3],
            valid  => 0,
        },
        {
            name   => 'div_by: (ok)',
            input  => 6,
            schema => [int => div_by => 3],
            valid  => 1,
        },

    );

    # XXX multi_cval for mod
    # XXX multi_cval for div_by
    # XXX div_by 0
}

sub gen_float_tests {
    my %args = @_;
    my @res;

    local $Type = "float";

    (
        gen_type_check_tests(
            accept => [-1.1, -1, 0, 1, 1.1], # XXX -Inf, NaN, Inf
            reject => ["a", [], {}],
        ),
        gen_BaseType_tests(
            value => 1.1,
            ok_defaults  => [1.1],
            nok_defaults => [[]],
        ),
        gen_err_level_tests(
            clause    => 'min',
            cval      => 0,
            ok_value  =>  0.1,
            nok_value => -0.1,
        ),
        gen_Comparable_tests(
            values => [1.1, 1.2],
        ),
        gen_Sortable_tests(
            values => [-3.1, 2.1, 4.1],
        ),

        # is_{nan,inf,pos_inf,neg_inf} is currently tested in perl compiler
    );
}

sub gen_array_tests {
    my %args = @_;
    my @res;

    local $Type = "array";

    push @res, (
        gen_type_check_tests(
            accept => [[], [1, "a"], [[]]],
            reject => [1, "a", {}],
        ),
        gen_BaseType_tests(
            value => [],
            ok_defaults  => [[]],
            nok_defaults => ["a"],
        ),
        gen_err_level_tests(
            clause    => 'is',
            cval      => [],
            ok_value  => [],
            nok_value => [0],
        ),
        gen_Comparable_tests(
            values => [[1], [2]],
        ),

        gen_HasElems_tests(
            # two values, each value is [VAL, LEN].
            values => [ [[1], 1], [[1, 1.2], 2] ],
            # will be tested on the second value
            ok_each_index  => [int =>  max => 1],
            nok_each_index => [int => xmax => 1],
            ok_each_elem   => "float",
            nok_each_elem  => "int",
        ),
    );

    my $sch = [array => {elems => ["int", ["int", default=>2]]}];
    push @res, (
        {
            name   => 'elems (nok, first elem required)',
            input  => [],
            schema => $sch,
            valid  => 0,
        },
        {
            name   => 'elems (ok, missing elem set to undef)',
            input  => [1],
            schema => $sch,
            valid  => 1,
        },
        {
            name   => 'elems (ok, second elem optional)',
            input  => [1, undef],
            schema => $sch,
            valid  => 1,
        },
        {
            name   => 'elems (ok 2)',
            input  => [1, 1.1],
            schema => $sch,
            valid  => 1,
        },
        {
            name   => 'elems (ok, extra elems ignored)',
            input  => [1, 1.1, undef],
            schema => $sch,
            valid  => 1,
        },
        {
            name   => 'elems (ok, extra elems ignored 2)',
            input  => [1, 1.1, "foo"],
            schema => $sch,
            valid  => 1,
        },
    );

    $sch = [array => {elems => ["int", ["int", default=>2]],
                      "elems.create_default"=>0}];
    push @res, (
        {
            name   => 'elems (ok, create_default=0)',
            input  => [1],
            schema => $sch,
            valid  => 1,
            output => [1],
        },
        {
            name   => 'elems (ok 2, create_default=0)',
            input  => [1, undef],
            schema => $sch,
            valid  => 1,
            output => [1, 2],
        },
    );

    @res;
}

sub gen_str_tests {
    my %args = @_;
    my @res;

    local $Type = "str";

    push @res, (
        gen_type_check_tests(
            accept => [0, 1.1, "", "str\n"],
            reject => [[], {}],
        ),
        gen_BaseType_tests(
            value => "a",
            ok_defaults  => ["a"],
            nok_defaults => [[]],
        ),
        gen_err_level_tests(
            clause    => 'is',
            cval      => "a",
            ok_value  => "a",
            nok_value => "a\n",
        ),
        gen_Comparable_tests(
            values => ["a", "b"],
        ),

        gen_Sortable_tests(
            values => ["", "a", "ab"],
        ),

        gen_HasElems_tests(
            # two values, each value is [VAL, LEN]
            values => [ ["a", 1], ["abc", 3] ],
            # will be tested on the second value
            ok_each_index  => [int =>  max => 2],
            nok_each_index => [int => xmax => 2],
            ok_each_elem   => "str",
            nok_each_elem  => "float",
        ),

        {
            name   => 'match: (ok)',
            input  => "a",
            schema => [str => match => "[abc]"],
            valid  => 1,
        },
        {
            name   => 'match: (nok)',
            input  => "z",
            schema => [str => match => "[abc]"],
            valid  => 0,
        },
        {
            name   => 'match: (nok, invalid regex)',
            input  => "a",
            schema => [str => match => "("],
            dies   => 1,
        },

        {
            name   => 'is_re: 1 (ok)',
            input  => "a",
            schema => [str => is_re => 1],
            valid  => 1,
        },
        {
            name   => 'is_re: 1 (nok)',
            input  => "a(",
            schema => [str => is_re => 1],
            valid  => 0,
        },
        {
            name   => 'is_re: 0 (ok)',
            input  => "a(",
            schema => [str => is_re => 0],
            valid  => 1,
        },
        {
            name   => 'is_re: 0 (nok)',
            input  => "a",
            schema => [str => is_re => 0],
            valid  => 0,
        },

    );

    @res;
}

sub gen_hash_tests {
    my %args = @_;
    my @res;
    my ($sch, $sch2);

    local $Type = "hash";

    push @res, (
        gen_type_check_tests(
            accept => [{}, {a=>1}, {""=>[]}],
            reject => [1, "a", []],
        ),
        gen_BaseType_tests(
            value => {},
            ok_defaults  => [{}],
            nok_defaults => ["a"],
        ),
        gen_err_level_tests(
            clause    => 'is',
            cval      => {a=>0},
            ok_value  => {a=>0},
            nok_value => {a=>1},
        ),
        gen_Comparable_tests(
            values => [{}, {a=>1}],
        ),

        gen_HasElems_tests(
            # two values, each value is [VAL, LEN].
            values => [ [{a=>1}, 1], [{a=>1, b=>1.1}, 2] ],
            # will be tested on the second value
            ok_each_index  => [str => len=>1],
            nok_each_index => [str => len=>2],
            ok_each_elem   => "float",
            nok_each_elem  => "int",
        )
    );

    $sch  = [hash => {keys => {a=>"int", b=>"float*"}}];
    $sch2 = [hash => {keys => {a=>"int", b=>"float*"}}];

    push @res, (
        {
            name   => 'keys: (ok, empty)',
            input  => {},
            schema => $sch,
            valid  => 1,
        },
        {
            name   => 'keys: (ok, only a, a valid 1)',
            input  => {a=>undef},
            schema => $sch,
            valid  => 1,
        },
        {
            name   => 'keys: (ok, only a, a valid 2)',
            input  => {a=>1},
            schema => $sch,
            valid  => 1,
        },
        {
            name   => 'keys: (nok, only a, a invalid)',
            input  => {a=>1.1},
            schema => $sch,
            valid  => 0,
        },
        {
            name   => 'keys: (ok, only a, valid 2)',
            input  => {a=>1},
            schema => $sch,
            valid  => 1,
        },
        {
            name   => 'keys: (ok, a & b, valid)',
            input  => {a=>1, b=>1.1},
            schema => $sch,
            valid  => 1,
        },
        {
            name   => 'keys: (nok, a & b, b invalid)',
            input  => {a=>1, b=>undef},
            schema => $sch,
            valid  => 0,
        },
        {
            name   => 'keys: (nok, a & b, a invalid)',
            input  => {a=>1.1, b=>1.1},
            schema => $sch,
            valid  => 0,
        },
        {
            name   => 'keys: (nok, a & b, a & b invalid)',
            input  => {a=>1.1, b=>undef},
            schema => $sch,
            valid  => 0,
        },
        {
            name   => 'keys: (nok, extra)',
            input  => {a=>1, b=>1.1, c=>1},
            schema => $sch,
            valid  => 0,
        },
        {
            name   => 'keys: (ok, extra, restrict=0)',
            input  => {a=>1, b=>1.1, c=>1},
            schema => $sch,
            valid  => 0,
        },
    );


    $sch = [hash => {keys => {a=>"int", b=>["int", default=>2]}}];
    push @res, (
        {
            name   => 'keys (create_default=1) 1',
            input  => {},
            schema => $sch,
            valid  => 1,
            output => {b=>2},
        },
        {
            name   => 'keys (create_default=1) 2',
            input  => {b=>undef},
            schema => $sch,
            valid  => 1,
            output => {b=>2},
        },
    );
    $sch = [hash => {keys => {a=>"int", b=>["int", default=>2]},
                     "keys.create_default" => 0}];
    push @res, (
        {
            name   => 'keys (create_default=0) 1',
            input  => {},
            schema => $sch,
            valid  => 1,
            output => {},
        },
        {
            name   => 'keys (create_default=0) 2',
            input  => {b=>undef},
            schema => $sch,
            valid  => 1,
            output => {b=>2},
        },
    );

    # XXX re_keys
    # XXX req_keys
    # XXX allowed_keys
    # XXX allowed_keys_re

    @res;
}

sub gen_bool_tests {
    my %args = @_;
    my @res;

    # XXX how to dump YAML's boolean?

    local $Type = "bool";

    (
        gen_type_check_tests(
            accept => [0, 1],
            reject => [[], {}], # in perl, "a", -2, 3.4 are ok
        ),
        gen_BaseType_tests(
            value => 1,
            ok_defaults  => [1],
            nok_defaults => [[]],
        ),
        gen_err_level_tests(
            clause    => 'is',
            cval      => 1,
            ok_value  => 1,
            nok_value => 0,
        ),
        gen_Comparable_tests(
            values => [0, 1],
        ),
        gen_Sortable_tests(
            values => [0, 1, 1],
        ),

        {
            name   => 'is_true: 1 (ok)',
            input  => 1,
            schema => [$Type => is_true => 1],
            valid  => 1,
        },
        {
            name   => 'is_true: 1 (nok)',
            input  => 0,
            schema => [$Type => is_true => 1],
            valid  => 0,
        },
        {
            name   => 'is_true: 0 (ok)',
            input  => 0,
            schema => [$Type => is_true => 0],
            valid  => 1,
        },
        {
            name   => 'is_true: 0 (nok)',
            input  => 1,
            schema => [$Type => is_true => 0],
            valid  => 0,
        },
        {
            name   => 'is_true: undef (ok 1)',
            input  => 0,
            schema => [$Type => is_true => undef],
            valid  => 1,
        },
        {
            name   => 'is_true: undef (ok 2)',
            input  => 1,
            schema => [$Type => is_true => undef],
            valid  => 1,
        },
    );
}

sub gen_any_tests {
    my %args = @_;
    my @res;

    local $Type = "any";

    (
        {
            name   => 'of (nok + nok)',
            input  => 3,
            schema => [$Type => of => [[int => div_by=>2], [int => div_by=>5]]],
            valid  => 0,
        },
        {
            name   => 'of (ok + nok)',
            input  => 2,
            schema => [$Type => of => [[int => div_by=>2], [int => div_by=>5]]],
            valid  => 1,
        },
        {
            name   => 'of (nok + ok)',
            input  => 5,
            schema => [$Type => of => [[int => div_by=>2], [int => div_by=>5]]],
            valid  => 1,
        },
        {
            name   => 'of (ok + ok)',
            input  => 10,
            schema => [$Type => of => [[int => div_by=>2], [int => div_by=>5]]],
            valid  => 1,
        },
    );
}

sub gen_all_tests {
    my %args = @_;
    my @res;

    local $Type = "all";

    (
        {
            name   => 'of (nok + nok)',
            input  => 3,
            schema => [$Type => of => [[int => div_by=>2], [int => div_by=>5]]],
            valid  => 0,
        },
        {
            name   => 'of (ok + nok)',
            input  => 2,
            schema => [$Type => of => [[int => div_by=>2], [int => div_by=>5]]],
            valid  => 0,
        },
        {
            name   => 'of (nok + ok)',
            input  => 5,
            schema => [$Type => of => [[int => div_by=>2], [int => div_by=>5]]],
            valid  => 0,
        },
        {
            name   => 'of (ok + ok)',
            input  => 10,
            schema => [$Type => of => [[int => div_by=>2], [int => div_by=>5]]],
            valid  => 1,
        },
    );
}

{
    my $now = localtime();
    local $YAML::Syck::Headless = 1;
    local $YAML::Syck::ImplicitTyping = 1;
    for my $type (qw(int float array str hash bool any all)) {
        my $f = "gen_${type}_tests";
        no strict 'refs';
        write_file(
            "$Bin/../share/spectest/10-type-$type.yaml",
            join(
                "",
                "# Generated by $0 v$VERSION on $now\n\n",
                Dump({tests => [$f->()]}),
            )
        );
    }
}
