use strict;
use warnings;
use Test::More;
use MooseX::Method::Signatures;
{
package Bar::Foo;
use Moose;
}
my $ISTODO = 1;
my $ISFAIL = 2;
# == 0 disables TODO mode
my $dotodo = 1;
my @signatures;
@signatures = (
# basic tests.
[ 0, '$arg', 'Optional(implicit) Positional' ], #1
[ 0, '$arg?', 'Optional Positional' ],
[ 0, '$arg!', 'Required Positional' ],
[ 0, ':$arg', 'Required(implicit) Named' ],
[ 0, ':$arg?', 'Optional Named' ],
[ 0, ':$arg!', 'Required Named' ], #6
# type tests
[ 0, 'Str $arg', 'Positional String Type' ], #7
[ 0, 'Int $arg', 'Positional Int Type' ],
[ 0, 'Bar::Foo $arg', 'Positional Class Type' ],
[ 0, 'Str :$arg', 'Named String Type' ],
[ 0, 'Int :$arg', 'Named Int Type' ],
[ 0, 'Bar::Foo :$arg', 'Named Class Type' ], #12
# coerce does tests
[ 0, 'Str $arg does coerce', 'COERCE Positional String Type' ], # 13
[ 0, 'Int $arg does coerce ', 'COERCE Positional Int Type' ],
[ 0, 'Bar::Foo $arg does coerce', 'COERCE Positi Class Type' ],
[ 0, 'Str :$arg does coerce', 'COERCE Named String Type' ],
[ 0, 'Int :$arg does coerce', 'COERCE Named Int Type' ],
[ 0, 'Bar::Foo :$arg does coerce', 'COERCE Named Class Type' ],
[ 0, ':$arg does coerce', 'COERCE Named ' ],
[ 0, '$arg does coerce', 'COERCE Postional ' ], # 20
# coerce is tests
[ 0, 'Str $arg does coerce', 'COERCE_IS Positional String Type' ], #21
[ 0, 'Int $arg does coerce ', 'COERCE_IS Positional Int Type' ],
[ 0, 'Bar::Foo $arg does coerce', 'COERCE_IS Positi Class Type' ],
[ 0, 'Str :$arg does coerce', 'COERCE_IS Named String Type' ],
[ 0, 'Int :$arg does coerce', 'COERCE_IS Named Int Type' ],
[ 0, 'Bar::Foo :$arg does coerce', 'COERCE_IS Named Class Type' ],
[ 0, ':$arg does coerce', 'COERCE_IS Named ' ],
[ 0, '$arg does coerce', 'COERCE_IS Postional ' ], # 28
# coerce is where tests
[
0,
'Str $arg does coerce where { 1 } ',
'COERCE_WHERE Positional String Type'
], #29
[
0,
'Int $arg does coerce where { 1 } ',
'COERCE_WHERE Positional Int Type'
],
[
0,
'Bar::Foo $arg does coerce where { 1 }',
'COERCE_WHERE Positi Class Type'
],
[
0,
'Str :$arg does coerce where { 1 }',
'COERCE_WHERE Named String Type'
],
[
0,
'Int :$arg does coerce where { 1 }',
'COERCE_WHERE Named Int Type'
],
[
0,
'Bar::Foo :$arg does coerce where { 1 }',
'COERCE_WHERE Named Class Type'
],
[ 0, ':$arg does coerce where { 1 } ', 'COERCE_WHERE Named ' ],
[ 0, '$arg does coerce where { 1 }', 'COERCE_WHERE Postional ' ], # 36
# where tests
[ 0, 'Str $arg where { 1 } ', 'WHERE Positional String Type' ], #37
[ 0, 'Int $arg where { 1 } ', 'WHERE Positional Int Type' ],
[ 0, 'Bar::Foo $arg where { 1 }', 'WHERE Positi Class Type' ],
[ 0, 'Str :$arg where { 1 }', 'WHERE Named String Type' ],
[ 0, 'Int :$arg where { 1 }', 'WHERE Named Int Type' ],
[ 0, 'Bar::Foo :$arg where { 1 }', 'WHERE Named Class Type' ],
[ 0, ':$arg where { 1 } ', 'WHERE Named ' ],
[ 0, '$arg where { 1 }', 'WHERE Postional ' ], # 44
# defaults tests.
[ 0, '$arg = 42', 'Default+ Optional(implicit) Positional' ], #45
[ 0, '$arg? = 42', 'Default+ Optional Positional' ],
[ 0, '$arg! = 42', 'Default+ Required Positional' ],
[ 0, ':$arg = 42', 'Default+ Required(implicit) Named' ],
[ 0, ':$arg? = 42', 'Default+ Optional Named' ],
[ 0, ':$arg! = 42', 'Default+ Required Named' ], #50
# invocant tests.
[ 0, '$self: $arg', 'Invocant + Positional ' ], #51
[ 0, '$class: $arg', 'Nondefault Invocant + Positional ' ],
[ 0, '$self: :$arg', 'Invocant + Named ' ], #53
[ 0, '$class: :$arg', 'Nondefault Invocant + Named ' ],
# label tests .
[ 0, ':foo($arg)', 'Label' ], #55
);
plan tests => $#signatures + 1;
# --------[ EXECUTE ]------------------------------------------------------- #
my $template = do { local $/ = undef; <DATA> };
my $package_iteration = 'A';
for my $test (@signatures) {
my $pkg = $package_iteration;
$package_iteration++;
my ( $stability, $signature, $description ) = @{$test};
my $dotest = sub {
my $code = sprintf $template, $pkg, $signature, '$arg';
my $message = "$description (Test: $pkg Syntax: '( $signature )') ";
my $res = 1;
$res = eval $code;
if ( $@ eq '' ) {
pass($message);
}
else {
fail($message)
#. "\n------\n$@\n--------\n" );
}
};
if ( $dotodo && ( $stability & $ISTODO ) ) {
TODO: {
local $TODO = 'Signatures/Coercion Support';
$dotest->();
}
}
else {
$dotest->();
}
}
__DATA__
{
package %s;
use Moose;
use MooseX::Method::Signatures;
use Moose::Util::TypeConstraints;
method alpha ( %s ){
return %s;
};
}