view release on metacpan or  search on metacpan

t/02toolkit/06Params.t  view on Meta::CPAN

=pod

=head1 PURPOSE

Using the test cases from Type::Params

=head1 AUTHOR

Toby Inkster E<lt>tobyink@cpan.orgE<gt>.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2013-2014, 2017-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::Exception;

BEGIN {
  if ( eval { require TUI::toolkit::Types } ) {
    note 'use TUI::toolkit::Types';
    use_ok 'TUI::toolkit::Types', qw( 
      Any Int ArrayRef HashRef ClassName Str Object Num Ref is_HashRef
    );
  }
  elsif ( eval { require Types::Standard } ) {
    note 'use Types::Standard';
    use_ok 'Types::Standard', qw(
      Any Int ArrayRef HashRef ClassName Str Object Num Ref is_HashRef
    );
  } 
  else {
    plan skip_all => 'Test irrelevant without a Type constraint library';
  }
  # use_ok 'Type::Params', qw( compile signature );
  use_ok 'TUI::toolkit::Params', qw( signature );
}

#
# Check that people doing silly things with *::Params get
#
subtest '/t/20-modules/Type-Params/badsigs.t' => sub {
  throws_ok {
    signature(
      pos => [
        Int, { optional => 1 },
        Int,
      ]
    )
  } qr{^Non-Optional parameter following Optional parameter},
      "Cannot follow an optional parameter with a required parameter";

  throws_ok {
    signature(
      pos => [
        ArrayRef[Int], { slurpy   => 1 },
        Int,           { optional => 1 },
      ]
    )
  } qr{^Parameter following slurpy parameter},
      "Cannot follow a slurpy parameter with anything";

  lives_ok {
    signature( pos => [ Int, { slurpy => 1 } ] )
  } "This makes no sense, but no longer throws an exception";
};

#
# Test C<*::Params> interaction with L<Carp>:
#
{ 
my $check;

subtest '/t/20-modules/Type-Params/carping.t' => sub {

  sub testsub1 {
    $check ||= signature( pos => [ Int ] );
    [ $check->( @_ ) ];
  }

  sub testsub2 {
    testsub1( @_ );
  }
  
  eval {
    testsub2( 1.1 );
  };
  like(
    $@,
    qr{^Value "1\.1" did not pass type constraint "Int" \(in \$_\[0\]\)},
    do { $@ =~ /\bline (\d+)\b/, "croak at line $1" || '' }
  );

}}

#
# Test C<compile> support defaults for parameters.
#
subtest '/t/20-modules/Type-Params/defaults.t' => sub {
  my @rv;

  lives_ok { @rv = signature( pos => [ Int, { default => 42 } ] )->() }