—

              
HideShow 20 lines of Pod
=pod
=encoding utf-8
=head1 PURPOSE
Tests new C<multi> option in Type::Params.
=head1 AUTHOR
Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2022-2025 by Toby Inkster.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
use strict;
use warnings;
use Test::More;
use Test::Fatal;
use Types::Common -sigs, -types;
{
        my $sig;
        sub array_lookup {
                $sig ||= signature(
                        method => 1,
                        multi  => [
                                { multi => [
                                        { pos   => [ ArrayRef, Int ] },
                                        { pos   => [ Int, ArrayRef ], next => sub { @_[0, 2, 1] } },
                                ] },
                                { named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 },
                                { pos   => [ ArrayRef, Int ], method => 0, next => sub { ( undef, @_ ) } },
                                { named => [ LIST => ArrayRef, INDEX => Int ], next => sub { my $arg = pop; ( undef, $arg->LIST, $arg->INDEX ) } },
                                sub { return ( undef, ['helloworld'], 0 ) if ( $_[0] and $_[0] eq 'HELLOWORLD' ); die },
                        ],
                );
                 
                my ( $self, $arr, $ix ) = &$sig;
                return $arr->[$ix];
        }
        subtest "signature( multi => [...] )" => sub {
                note signature(
                        method => 1,
                        multi  => [
                                { multi => [
                                        { pos   => [ ArrayRef, Int ] },
                                        { pos   => [ Int, ArrayRef ], next => sub { @_[0, 2, 1] } },
                                ] },
                                { named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 },
                                { pos   => [ ArrayRef, Int ], method => 0, next => sub { ( undef, @_ ) } },
                                { named => [ ARRAY => ArrayRef, INDEX => Int ], named_to_list => 1 },
                                sub { return ( undef, ['helloworld'], 0 ) if ( $_[0] and $_[0] eq 'HELLOWORLD' ); die },
                        ],
                        want_source => 1,
                );
                note signature(
                        method => 1,
                        multi  => [
                                { multi => [
                                        { pos   => [ ArrayRef, Int ] },
                                        { pos   => [ Int, ArrayRef ], next => sub { @_[0, 2, 1] } },
                                ] },
                                { named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 },
                                { pos   => [ ArrayRef, Int ], method => 0, next => sub { ( undef, @_ ) } },
                                { named => [ LIST => ArrayRef, INDEX => Int ], next => sub { my $arg = pop; ( undef, $arg->LIST, $arg->INDEX ) } },
                                sub { return ( undef, ['helloworld'], 0 ) if ( $_[0] and $_[0] eq 'HELLOWORLD' ); die },
                        ],
                        want_object => 1,
                )->make_class_pp_code;
                my @arr    = qw( foo bar baz quux );
                my $ix     = 2;
                my $expect = 'baz';
                 
                is(
                        __PACKAGE__->array_lookup( \@arr, $ix ),
                        $expect,
                        'first alternative',
                );
                 
                is(
                        __PACKAGE__->array_lookup( $ix, \@arr ),
                        $expect,
                        'second alternative',
                );
                 
                is(
                        __PACKAGE__->array_lookup( array => \@arr, index => $ix ),
                        $expect,
                        'third alternative (hash)',
                );
                 
                is(
                        __PACKAGE__->array_lookup( { array => \@arr, index => $ix } ),
                        $expect,
                        'third alternative (hashref)',
                );
                 
                is(
                        __PACKAGE__->array_lookup( array => \@arr, ix => $ix ),
                        $expect,
                        'third alternative (hash, alias)',
                );
                 
                is(
                        __PACKAGE__->array_lookup( { array => \@arr, ix => $ix } ),
                        $expect,
                        'third alternative (hashref, alias)',
                );
                 
                is(
                        array_lookup( \@arr, $ix ),
                        $expect,
                        'fourth alternative',
                );
                 
                is(
                        __PACKAGE__->array_lookup( LIST => \@arr, INDEX => $ix ),
                        $expect,
                        'fifth alternative',
                );
                 
                is(
                        array_lookup( 'HELLOWORLD' ),
                        'helloworld',
                        'final alternative',
                );
                 
                my $e = exception { array_lookup() };
                like $e, qr/Parameter validation failed/;
                 
                is ${^_TYPE_PARAMS_MULTISIG}, undef;
        };
}
{
        signature_for array_lookup2 => (
                method => 1,
                multi  => [
                        { multi => [
                                { ID =>'foo', pos   => [ ArrayRef, Int ] },
                                { ID =>'bar', pos   => [ Int, ArrayRef ], next => sub { @_[0, 2, 1] } },
                        ] },
                        { ID =>'third', named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 },
                        { ID =>'fourth', pos   => [ ArrayRef, Int ], method => 0, next => sub { ( undef, @_ ) } },
                        { ID =>'fifth', named => [ LIST => ArrayRef, INDEX => Int ], next => sub { my $arg = pop; ( undef, $arg->LIST, $arg->INDEX ) } },
                        sub { return ( undef, ['helloworld'], 0 ) if ( $_[0] and $_[0] eq 'HELLOWORLD' ); die },
                ],
        );
         
        sub array_lookup2 {
                my ( $self, $arr, $ix ) = @_;
                return $arr->[$ix];
        }
         
        subtest "signature_for function => ( multi => [...] )" => sub {
                 
                my @arr    = qw( foo bar baz quux );
                my $ix     = 2;
                my $expect = 'baz';
                 
                is(
                        __PACKAGE__->array_lookup2( \@arr, $ix ),
                        $expect,
                        'first alternative',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 0;
                 
                is(
                        __PACKAGE__->array_lookup2( $ix, \@arr ),
                        $expect,
                        'second alternative',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 0;
                 
                is(
                        __PACKAGE__->array_lookup2( array => \@arr, index => $ix ),
                        $expect,
                        'third alternative (hash)',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'third';
                 
                is(
                        __PACKAGE__->array_lookup2( { array => \@arr, index => $ix } ),
                        $expect,
                        'third alternative (hashref)',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'third';
                 
                is(
                        __PACKAGE__->array_lookup2( array => \@arr, ix => $ix ),
                        $expect,
                        'third alternative (hash, alias)',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'third';
                 
                is(
                        __PACKAGE__->array_lookup2( { array => \@arr, ix => $ix } ),
                        $expect,
                        'third alternative (hashref, alias)',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'third';
                 
                is(
                        array_lookup2( \@arr, $ix ),
                        $expect,
                        'fourth alternative',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'fourth';
                 
                is(
                        __PACKAGE__->array_lookup2( LIST => \@arr, INDEX => $ix ),
                        $expect,
                        'fifth alternative',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'fifth';
                 
                is(
                        array_lookup2( 'HELLOWORLD' ),
                        'helloworld',
                        'final alternative',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 4;
                 
                my $e = exception { array_lookup2() };
                like $e, qr/Parameter validation failed/;
                 
                is ${^_TYPE_PARAMS_MULTISIG}, undef;
        };
}
{
        signature_for array_lookup3 => (
                method => 1,
                multi  => {
                        first   => { pos   => [ ArrayRef, Int ] },
                        second  => { pos   => [ Int, ArrayRef ], next => sub { @_[0, 2, 1] } },
                        third   => { named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 },
                        fourth  => { pos   => [ ArrayRef, Int ], method => 0, next => sub { ( undef, @_ ) } },
                        fifth   => { named => [ LIST => ArrayRef, INDEX => Int ], next => sub { my $arg = pop; ( undef, $arg->LIST, $arg->INDEX ) } },
                        sixth   => sub { return ( undef, ['helloworld'], 0 ) if ( $_[0] and $_[0] eq 'HELLOWORLD' ); die },
                },
        );
         
        sub array_lookup3 {
                my ( $self, $arr, $ix ) = @_;
                return $arr->[$ix];
        }
         
        subtest "signature_for function => ( multi => {...} )" => sub {
                 
                my @arr    = qw( foo bar baz quux );
                my $ix     = 2;
                my $expect = 'baz';
                 
                is(
                        __PACKAGE__->array_lookup3( \@arr, $ix ),
                        $expect,
                        'first alternative',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'first';
                 
                is(
                        __PACKAGE__->array_lookup3( $ix, \@arr ),
                        $expect,
                        'second alternative',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'second';
                 
                is(
                        __PACKAGE__->array_lookup3( array => \@arr, index => $ix ),
                        $expect,
                        'third alternative (hash)',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'third';
                 
                is(
                        __PACKAGE__->array_lookup3( { array => \@arr, index => $ix } ),
                        $expect,
                        'third alternative (hashref)',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'third';
                 
                is(
                        __PACKAGE__->array_lookup3( array => \@arr, ix => $ix ),
                        $expect,
                        'third alternative (hash, alias)',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'third';
                 
                is(
                        __PACKAGE__->array_lookup3( { array => \@arr, ix => $ix } ),
                        $expect,
                        'third alternative (hashref, alias)',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'third';
                 
                is(
                        array_lookup3( \@arr, $ix ),
                        $expect,
                        'fourth alternative',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'fourth';
                 
                is(
                        __PACKAGE__->array_lookup3( LIST => \@arr, INDEX => $ix ),
                        $expect,
                        'fifth alternative',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'fifth';
                 
                is(
                        array_lookup3( 'HELLOWORLD' ),
                        'helloworld',
                        'final alternative',
                );
                 
                is ${^_TYPE_PARAMS_MULTISIG}, 'sixth';
                 
                my $e = exception { array_lookup3() };
                like $e, qr/Parameter validation failed/;
                 
                is ${^_TYPE_PARAMS_MULTISIG}, undef;
        };
}
{
        my $sig;
        sub xyz {
                $sig ||= signature(
                        named => [ { next => sub { shift->foo } }, foo => Int, { alias => 'foolish' } ],
                        pos   => [ Int ],
                        multi => 1,
                );
                my ( $int ) = &$sig;
                return $int;
        }
        subtest "signature( named => ..., pos => ..., multi => 1 )" => sub {
                note signature(
                        named => [ { next => sub { shift->foo } }, foo => Int, { alias => 'foolish' } ],
                        pos   => [ Int ],
                        multi => 1,
                        want_source => 1,
                );
                 
                is xyz( foo => 666 ), 666;
                is ${^_TYPE_PARAMS_MULTISIG}, 0;
                 
                is xyz( { foolish => 999 } ), 999;
                is ${^_TYPE_PARAMS_MULTISIG}, 0;
                 
                is xyz(42), 42;
                is ${^_TYPE_PARAMS_MULTISIG}, 1;
        };
}
my $e = exception {
        signature multiple => [ 123 ];
};
like $e, qr/Alternative signatures must be CODE, HASH, or ARRAY refs/;
done_testing;