[p5sagit/Function-Parameters.git] / t / foreign / Method-Signatures / type_check.t

#!perl

use strict;
use warnings FATAL => 'all';

use Test::More
	eval { require Moose; 1 }
	? ()
	: (skip_all => "Moose required for testing types")
;
use Test::More;
use Test::Fatal;

use Function::Parameters qw(:strict);


{ package Foo::Bar; sub new { bless {}, __PACKAGE__; } }
{ package Foo::Baz; sub new { bless {}, __PACKAGE__; } }

our $foobar = Foo::Bar->new;
our $foobaz = Foo::Baz->new;


# types to check below
# the test name needs to be interpolated into a method name, so it must be a valid identifier
# either good value or bad value can be an array reference:
#   *   if it is, it is taken to be multiple values to try
#   *   if you want to pass an array reference, you have to put it inside another array reference
#   *   so, [ 42, undef ] makes two calls: one with 42, and one with undef
#   *   but [[ 42, undef ]] makes one call, passing [ 42, undef ]
our @TYPES =
(
##  Test Name       =>  Type                =>  Good Value                      =>  Bad Value
    int             =>  'Int'               =>  42                              =>  'foo'                               ,
    bool            =>  'Bool'              =>  0                               =>  'fool'                              ,
    aref            =>  'ArrayRef',         =>  [[ 42, undef ]]                 =>  42                                  ,
    class           =>  'Foo::Bar'          =>  $foobar                         =>  $foobaz                             ,
    maybe_int       =>  'Maybe[Int]'        =>  [ 42, undef ]                   =>  'foo'                               ,
    paramized_aref  =>  'ArrayRef[Num]'     =>  [[ 6.5, 42, 1e23 ]]             =>  [[ 6.5, 42, 'thing' ]]              ,
    paramized_href  =>  'HashRef[Num]'      =>  { a => 6.5, b => 2, c => 1e23 } =>  { a => 6.5, b => 42, c => 'thing' } ,
##  ScalarRef[X] not implemented in Mouse, so this test is moved to typeload_moose.t
##  if Mouse starts supporting it, the test could be restored here
    paramized_sref  =>  'ScalarRef[Num]'    =>  \42                             =>  \'thing'                            ,
    int_or_aref     =>  'Int|ArrayRef[Int]' =>  [ 42 , [42 ] ]                  =>  'foo'                               ,
);


our $tester;
{
    package TypeCheck::Class;

    use Test::More;
    use Test::Fatal;

    method new ($class:) { bless {}, $class; }

    sub _list { return ref $_[0] eq 'ARRAY' ? @{$_[0]} : ( $_[0] ); }


    $tester = __PACKAGE__->new;
    while (@TYPES)
    {
        my ($name, $type, $goodval, $badval) = splice @TYPES, 0, 4;
        note "name/type/goodval/badval $name/$type/$goodval/$badval";
        my $method = "check_$name";
        no strict 'refs';

        # make sure the declaration of the method doesn't throw a warning
        is eval qq{ method $method ($type \$bar) {} 42 }, 42;
    	is $@, '';

        # positive test--can we call it with a good value?
        my @vals = _list($goodval);
        my $count = 1;
        foreach (@vals)
        {
            my $tag = @vals ? ' (alternative ' . $count++ . ')' : '';
            is exception { $tester->$method($_) }, undef, "call with good value for $name passes" . $tag;
        }

        # negative test--does calling it with a bad value throw an exception?
        @vals = _list($badval);
        $count = 1;
        foreach (@vals)
        {
            my $tag = @vals ? ' (#' . $count++ . ')' : '';
            like exception { $tester->$method($_) }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/,
                    "call with bad value for $name dies";
        }
    }


    # try some mixed (i.e. some with a type, some without) and multiples

    my $method = 'check_mixed_type_first';
    is eval qq{ method $method (Int \$bar, \$baz) {} 42 }, 42;
    is exception { $tester->$method(0, 'thing') }, undef, 'call with good values (type, notype) passes';
    like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/,
            'call with bad values (type, notype) dies';

    $method = 'check_mixed_type_second';
    is eval qq{ method $method (\$bar, Int \$baz) {} 42 }, 42;
    is exception { $tester->$method('thing', 1) }, undef, 'call with good values (notype, type) passes';
    like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 2\b.+\$baz\b.+Validation failed for '[^']+' with value\b/,
            'call with bad values (notype, type) dies';

    $method = 'check_multiple_types';
    is eval qq{ method $method (Int \$bar, Int \$baz) {} 42 }, 42;
    is exception { $tester->$method(1, 1) }, undef, 'call with good values (type, type) passes';
    # with two types, and bad values for both, they should fail in order of declaration
    like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/,
            'call with bad values (type, type) dies';

    # want to try one with undef as well to make sure we don't get an uninitialized warning

    like exception { $tester->check_int(undef) }, qr/method check_int.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/,
            'call with bad values (undef) dies';


    # finally, some types that shouldn't be recognized
    my $type;

    #$method = 'unknown_type';
    #$type = 'Bmoogle';
    #is eval qq{ method $method ($type \$bar) {} 42 }, 42;
    #like exception { $tester->$method(42) }, qr/ducks $tester, $type, "perhaps you forgot to load it?", $method/,
    #        'call with unrecognized type dies';

    # this one is a bit specialer in that it involved an unrecognized parameterization
    $method = 'unknown_paramized_type';
    $type = 'Bmoogle[Int]';
    is eval qq{ method $method ($type \$bar) {} 42 }, undef;
	like $@, qr/\QCould not locate the base type (Bmoogle)/;
    like exception { $tester->$method(42) }, qr/\QCan't locate object method "unknown_paramized_type" via package "TypeCheck::Class"/;
}


done_testing;
Commit	Line	Data
700071de	1	#!perl
	2
	3	use strict;
	4	use warnings FATAL => 'all';
	5
	6	use Test::More
	7	eval { require Moose; 1 }
	8	? ()
	9	: (skip_all => "Moose required for testing types")
	10	;
	11	use Test::More;
	12	use Test::Fatal;
	13
	14	use Function::Parameters qw(:strict);
	15
	16
	17	{ package Foo::Bar; sub new { bless {}, __PACKAGE__; } }
	18	{ package Foo::Baz; sub new { bless {}, __PACKAGE__; } }
	19
	20	our $foobar = Foo::Bar->new;
	21	our $foobaz = Foo::Baz->new;
	22
	23
	24	# types to check below
	25	# the test name needs to be interpolated into a method name, so it must be a valid identifier
	26	# either good value or bad value can be an array reference:
	27	# * if it is, it is taken to be multiple values to try
	28	# * if you want to pass an array reference, you have to put it inside another array reference
	29	# * so, [ 42, undef ] makes two calls: one with 42, and one with undef
	30	# * but [[ 42, undef ]] makes one call, passing [ 42, undef ]
	31	our @TYPES =
	32	(
	33	## Test Name => Type => Good Value => Bad Value
	34	int => 'Int' => 42 => 'foo' ,
	35	bool => 'Bool' => 0 => 'fool' ,
	36	aref => 'ArrayRef', => [[ 42, undef ]] => 42 ,
	37	class => 'Foo::Bar' => $foobar => $foobaz ,
	38	maybe_int => 'Maybe[Int]' => [ 42, undef ] => 'foo' ,
	39	paramized_aref => 'ArrayRef[Num]' => [[ 6.5, 42, 1e23 ]] => [[ 6.5, 42, 'thing' ]] ,
	40	paramized_href => 'HashRef[Num]' => { a => 6.5, b => 2, c => 1e23 } => { a => 6.5, b => 42, c => 'thing' } ,
	41	## ScalarRef[X] not implemented in Mouse, so this test is moved to typeload_moose.t
	42	## if Mouse starts supporting it, the test could be restored here
	43	paramized_sref => 'ScalarRef[Num]' => \42 => \'thing' ,
	44	int_or_aref => 'Int\|ArrayRef[Int]' => [ 42 , [42 ] ] => 'foo' ,
	45	);
	46
	47
	48	our $tester;
	49	{
	50	package TypeCheck::Class;
	51
	52	use Test::More;
	53	use Test::Fatal;
	54
	55	method new ($class:) { bless {}, $class; }
	56
	57	sub _list { return ref $_[0] eq 'ARRAY' ? @{$_[0]} : ( $_[0] ); }
	58
	59
	60	$tester = __PACKAGE__->new;
	61	while (@TYPES)
	62	{
	63	my ($name, $type, $goodval, $badval) = splice @TYPES, 0, 4;
	64	note "name/type/goodval/badval $name/$type/$goodval/$badval";
65	my $method = "check_$name";
66	no strict 'refs';
67
68	# make sure the declaration of the method doesn't throw a warning
69	is eval qq{ method $method ($type \$bar) {} 42 }, 42;
70	is $@, '';
71
72	# positive test--can we call it with a good value?
73	my @vals = _list($goodval);
74	my $count = 1;
75	foreach (@vals)
76	{
77	my $tag = @vals ? ' (alternative ' . $count++ . ')' : '';
78	is exception { $tester->$method($_) }, undef, "call with good value for $name passes" . $tag;
79	}
80
81	# negative test--does calling it with a bad value throw an exception?
82	@vals = _list($badval);
83	$count = 1;
84	foreach (@vals)
85	{
86	my $tag = @vals ? ' (#' . $count++ . ')' : '';
87	like exception { $tester->$method($_) }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/,
88	"call with bad value for $name dies";
89	}
90	}
91
92
93	# try some mixed (i.e. some with a type, some without) and multiples
94
95	my $method = 'check_mixed_type_first';
96	is eval qq{ method $method (Int \$bar, \$baz) {} 42 }, 42;
97	is exception { $tester->$method(0, 'thing') }, undef, 'call with good values (type, notype) passes';
98	like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/,
99	'call with bad values (type, notype) dies';
100
101	$method = 'check_mixed_type_second';
102	is eval qq{ method $method (\$bar, Int \$baz) {} 42 }, 42;
103	is exception { $tester->$method('thing', 1) }, undef, 'call with good values (notype, type) passes';
104	like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 2\b.+\$baz\b.+Validation failed for '[^']+' with value\b/,
105	'call with bad values (notype, type) dies';
106
107	$method = 'check_multiple_types';
108	is eval qq{ method $method (Int \$bar, Int \$baz) {} 42 }, 42;
109	is exception { $tester->$method(1, 1) }, undef, 'call with good values (type, type) passes';
110	# with two types, and bad values for both, they should fail in order of declaration
111	like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/,
112	'call with bad values (type, type) dies';
113
114	# want to try one with undef as well to make sure we don't get an uninitialized warning
115
116	like exception { $tester->check_int(undef) }, qr/method check_int.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/,
117	'call with bad values (undef) dies';
118
119
120
121	# finally, some types that shouldn't be recognized
122	my $type;
123
124	#$method = 'unknown_type';
125	#$type = 'Bmoogle';
126	#is eval qq{ method $method ($type \$bar) {} 42 }, 42;
127	#like exception { $tester->$method(42) }, qr/ducks $tester, $type, "perhaps you forgot to load it?", $method/,
128	# 'call with unrecognized type dies';
129
130	# this one is a bit specialer in that it involved an unrecognized parameterization
131	$method = 'unknown_paramized_type';
132	$type = 'Bmoogle[Int]';
133	is eval qq{ method $method ($type \$bar) {} 42 }, undef;
134	like $@, qr/\QCould not locate the base type (Bmoogle)/;
135	like exception { $tester->$method(42) }, qr/\QCan't locate object method "unknown_paramized_type" via package "TypeCheck::Class"/;
136	}
137
138
139	done_testing;