ヤミRoot VoidGate

Viewing: dict.t

use strict;
use warnings;

use Test::More 0.96;
use Test::Specio qw( test_constraint :vars );

use Specio::Declare;
use Specio::Library::Builtins;
use Specio::Library::Structured;

## no critic (Subroutines::ProtectPrivateSubs)
declare(
    'UCStr',
    parent => t('Str'),
    inline => sub {
        $_[0]->parent->_inline_check( $_[1] ) . " && $_[1] =~ /^[A-Z]+\$/";
    },
);
## use critic

declare(
    'Dict{ bar => Int, foo => UCStr }',
    parent => t(
        'Dict',
        of => {
            kv => {
                foo => t('UCStr'),
                bar => t('Int'),
            },
        },
    ),
);

declare(
    'Dict{ bar => Int, baz => Num?, foo => UCStr }',
    parent => t(
        'Dict',
        of => {
            kv => {
                foo => t('UCStr'),
                bar => t('Int'),
                baz => optional( t('Num') ),
            },
        },
    ),
);

declare(
    'Dict{ bar => Int, baz => Num?, foo => UCStr, HashRef... }',
    parent => t(
        'Dict',
        of => {
            kv => {
                foo => t('UCStr'),
                bar => t('Int'),
                baz => optional( t('Num') ),
            },
            slurpy => t('HashRef'),
        },
    ),
);

# The glob vars only work when they're use in the same package as where
# they're declared. Globs are weird.
my $GLOB = do {
    ## no critic (TestingAndDebugging::ProhibitNoWarnings)
    no warnings 'once';
    *SOME_GLOB;
};

## no critic (Variables::RequireInitializationForLocalVars)
local *FOO;
my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO );

local *BAR;
{
    ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen)
    open BAR, '<', $0 or die "Could not open $0 for the test";
}
my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR );

test_constraint(
    t('Dict{ bar => Int, foo => UCStr }'),
    {
        accept => [
            {
                foo => 'BAZ',
                bar => 42,
            },
            _T::HashOverload->new(
                {
                    foo => 'BAZ',
                    bar => 42,
                }
            ),
        ],
        reject => [
            $HASH_REF,
            {
                foo => 'baz',
                bar => 42,
            },
            {
                foo => 'BAZ',
                bar => 42.1,
            },
            { foo => 'BAZ' },
            { bar => 42 },
            $ZERO,
            $ONE,
            $BOOL_OVERLOAD_TRUE,
            $BOOL_OVERLOAD_FALSE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $NUM_OVERLOAD_ZERO,
            $NUM_OVERLOAD_ONE,
            $NUM_OVERLOAD_NEG,
            $NUM_OVERLOAD_NEG_DECIMAL,
            $NUM_OVERLOAD_DECIMAL,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $STR_OVERLOAD_EMPTY,
            $STR_OVERLOAD_FULL,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $SCALAR_OVERLOAD,
            $ARRAY_REF,
            $ARRAY_OVERLOAD,
            $CODE_REF,
            $CODE_OVERLOAD,
            $GLOB,
            $GLOB_REF,
            $GLOB_OVERLOAD,
            $GLOB_OVERLOAD_FH,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $REGEX_OVERLOAD,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
);

test_constraint(
    t('Dict{ bar => Int, baz => Num?, foo => UCStr }'),
    {
        accept => [
            {
                foo => 'BAZ',
                bar => 42,
            },
            _T::HashOverload->new(
                {
                    foo => 'BAZ',
                    bar => 42,
                }
            ),
            {
                foo => 'BAZ',
                bar => 42,
                baz => 42.1,
            },
            _T::HashOverload->new(
                {
                    foo => 'BAZ',
                    bar => 42,
                    baz => 42.1,
                }
            ),
        ],
        reject => [
            $HASH_REF,
            {
                foo => 'baz',
                bar => 42,
            },
            {
                foo => 'BAZ',
                bar => 42.1,
            },
            {
                foo => 'BAZ',
                bar => 42,
                baz => 'string',
            },
            { foo => 'BAZ' },
            { bar => 42 },
            $ZERO,
            $ONE,
            $BOOL_OVERLOAD_TRUE,
            $BOOL_OVERLOAD_FALSE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $NUM_OVERLOAD_ZERO,
            $NUM_OVERLOAD_ONE,
            $NUM_OVERLOAD_NEG,
            $NUM_OVERLOAD_NEG_DECIMAL,
            $NUM_OVERLOAD_DECIMAL,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $STR_OVERLOAD_EMPTY,
            $STR_OVERLOAD_FULL,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $SCALAR_OVERLOAD,
            $ARRAY_REF,
            $ARRAY_OVERLOAD,
            $CODE_REF,
            $CODE_OVERLOAD,
            $GLOB,
            $GLOB_REF,
            $GLOB_OVERLOAD,
            $GLOB_OVERLOAD_FH,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $REGEX_OVERLOAD,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
);

test_constraint(
    t('Dict{ bar => Int, baz => Num?, foo => UCStr, HashRef... }'),
    {
        accept => [
            {
                foo  => 'BAZ',
                bar  => 42,
                quux => {},
            },
            _T::HashOverload->new(
                {
                    foo  => 'BAZ',
                    bar  => 42,
                    quux => {},
                }
            ),
            {
                foo  => 'BAZ',
                bar  => 42,
                baz  => 42.1,
                quux => { x => 1 },
            },
            _T::HashOverload->new(
                {
                    foo  => 'BAZ',
                    bar  => 42,
                    baz  => 42.1,
                    quux => { x => 1 },
                }
            ),
        ],
        reject => [
            $HASH_REF,
            {
                foo => 'baz',
                bar => 42,
            },
            {
                foo => 'BAZ',
                bar => 42.1,
            },
            {
                foo => 'BAZ',
                bar => 42,
                baz => 'string',
            },
            { foo => 'BAZ' },
            { bar => 42 },
            $ZERO,
            $ONE,
            $BOOL_OVERLOAD_TRUE,
            $BOOL_OVERLOAD_FALSE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $NUM_OVERLOAD_ZERO,
            $NUM_OVERLOAD_ONE,
            $NUM_OVERLOAD_NEG,
            $NUM_OVERLOAD_NEG_DECIMAL,
            $NUM_OVERLOAD_DECIMAL,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $STR_OVERLOAD_EMPTY,
            $STR_OVERLOAD_FULL,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $SCALAR_OVERLOAD,
            $ARRAY_REF,
            $ARRAY_OVERLOAD,
            $CODE_REF,
            $CODE_OVERLOAD,
            $GLOB,
            $GLOB_REF,
            $GLOB_OVERLOAD,
            $GLOB_OVERLOAD_FH,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $REGEX_OVERLOAD,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
);

is(
    t('Dict{ bar => Int, foo => UCStr }')->parent->name,
    'Dict{ bar => Int, foo => UCStr }',
    'got expected name for simple Dict'
);

is(
    t('Dict{ bar => Int, baz => Num?, foo => UCStr }')->parent->name,
    'Dict{ bar => Int, baz => Num?, foo => UCStr }',
    'got expected name for Dict with optional key'
);

is(
    t('Dict{ bar => Int, baz => Num?, foo => UCStr, HashRef... }')
        ->parent->name,
    'Dict{ bar => Int, baz => Num?, foo => UCStr, HashRef... }',
    'got expected name for slurpy Dict with optional key'
);

done_testing();
User / IP	: 216.73.216.2
Host / Server	: 146.88.233.70 / dev.loger.cm
System	: Linux hybrid1120.fr.ns.planethoster.net 3.10.0-957.21.2.el7.x86_64 #1 SMP Wed Jun 5 14:26:44 UTC 2019 x86_64