t/type_constraints/inlining.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::Fatal;
   7 use Test::More;
   8
   9 use Moose::Util::TypeConstraints;
  10
  11 #<<<
  12 subtype 'Inlinable',
  13     as 'Str',
  14     where       { $_ !~ /Q/ },
  15     inline_as   { "defined $_[1] && ! ref $_[1] && $_[1] !~ /Q/" };
  16
  17 subtype 'NotInlinable',
  18     as 'Str',
  19     where { $_ !~ /Q/ };
  20 #>>>
  21
  22 my $inlinable     = find_type_constraint('Inlinable');
  23 my $not_inlinable = find_type_constraint('NotInlinable');
  24
  25 {
  26     ok(
  27         $inlinable->has_inlined_type_constraint,
  28         'Inlinable returns true for has_inlined_type_constraint'
  29     );
  30
  31     is(
  32         $inlinable->_inline_check('$foo'),
  33         'defined $foo && ! ref $foo && $foo !~ /Q/',
  34         'got expected inline code for Inlinable constraint'
  35     );
  36
  37     ok(
  38         !$not_inlinable->has_inlined_type_constraint,
  39         'NotInlinable returns false for has_inlined_type_constraint'
  40     );
  41
  42     like(
  43         exception { $not_inlinable->_inline_check('$foo') },
  44         qr/Cannot inline a type constraint check for NotInlinable/,
  45         'threw an exception when asking for inlinable code from type which cannot be inlined'
  46     );
  47 }
  48
  49 {
  50     my $aofi = Moose::Util::TypeConstraints::find_or_create_type_constraint(
  51         'ArrayRef[Inlinable]');
  52
  53     ok(
  54         $aofi->has_inlined_type_constraint,
  55         'ArrayRef[Inlinable] returns true for has_inlined_type_constraint'
  56     );
  57
  58     is(
  59         $aofi->_inline_check('$foo'),
  60         q{ref $foo eq 'ARRAY' && &List::MoreUtils::all( sub { defined $_ && ! ref $_ && $_ !~ /Q/ }, @{$foo} )},
  61         'got expected inline code for ArrayRef[Inlinable] constraint'
  62     );
  63
  64     my $aofni = Moose::Util::TypeConstraints::find_or_create_type_constraint(
  65         'ArrayRef[NotInlinable]');
  66
  67     ok(
  68         !$aofni->has_inlined_type_constraint,
  69         'ArrayRef[NotInlinable] returns false for has_inlined_type_constraint'
  70     );
  71 }
  72
  73 subtype 'ArrayOfInlinable',
  74     as 'ArrayRef[Inlinable]';
  75
  76 subtype 'ArrayOfNotInlinable',
  77     as 'ArrayRef[NotInlinable]';
  78
  79 {
  80     local $TODO = 'A subtype of a Parameterized type should not be a Parameterizable type';
  81
  82     my $aofi = Moose::Util::TypeConstraints::find_or_create_type_constraint(
  83         'ArrayOfInlinable');
  84
  85     ok(
  86         $aofi->has_inlined_type_constraint,
  87         'ArrayOfInlinable returns true for has_inlined_type_constraint'
  88     );
  89 }
  90
  91 {
  92     my $hoaofi = Moose::Util::TypeConstraints::find_or_create_type_constraint(
  93         'HashRef[ArrayRef[Inlinable]]');
  94
  95     ok(
  96         $hoaofi->has_inlined_type_constraint,
  97         'HashRef[ArrayRef[Inlinable]] returns true for has_inlined_type_constraint'
  98     );
  99
 100     is(
 101         $hoaofi->_inline_check('$foo'),
 102         q{ref $foo eq 'HASH' && &List::MoreUtils::all( sub { ref $_ eq 'ARRAY' && &List::MoreUtils::all( sub { defined $_ && ! ref $_ && $_ !~ /Q/ }, @{$_} ) }, values %{$foo} )},
 103         'got expected inline code for HashRef[ArrayRef[Inlinable]] constraint'
 104     );
 105
 106     my $hoaofni = Moose::Util::TypeConstraints::find_or_create_type_constraint(
 107         'HashRef[ArrayRef[NotInlinable]]');
 108
 109     ok(
 110         !$hoaofni->has_inlined_type_constraint,
 111         'HashRef[ArrayRef[NotInlinable]] returns false for has_inlined_type_constraint'
 112     );
 113 }
 114
 115 {
 116     my $iunion = Moose::Util::TypeConstraints::find_or_create_type_constraint(
 117         'Inlinable | Object');
 118
 119     ok(
 120         $iunion->has_inlined_type_constraint,
 121         'Inlinable | Object returns true for has_inlined_type_constraint'
 122     );
 123
 124     is(
 125         $iunion->_inline_check('$foo'),
 126         '(defined $foo && ! ref $foo && $foo !~ /Q/) || (Scalar::Util::blessed( $foo ))',
 127         'got expected inline code for Inlinable | Object constraint'
 128     );
 129
 130     my $niunion = Moose::Util::TypeConstraints::find_or_create_type_constraint(
 131         'NotInlinable | Object');
 132
 133     ok(
 134         !$niunion->has_inlined_type_constraint,
 135         'NotInlinable | Object returns false for has_inlined_type_constraint'
 136     );
 137 }
 138
 139 {
 140     my $iunion = Moose::Util::TypeConstraints::find_or_create_type_constraint(
 141         'Object | Inlinable');
 142
 143     ok(
 144         $iunion->has_inlined_type_constraint,
 145         'Object | Inlinable returns true for has_inlined_type_constraint'
 146     );
 147
 148     is(
 149         $iunion->_inline_check('$foo'),
 150         '(Scalar::Util::blessed( $foo )) || (defined $foo && ! ref $foo && $foo !~ /Q/)',
 151         'got expected inline code for Object | Inlinable constraint'
 152     );
 153
 154     my $niunion = Moose::Util::TypeConstraints::find_or_create_type_constraint(
 155         'Object | NotInlinable');
 156
 157     ok(
 158         !$niunion->has_inlined_type_constraint,
 159         'Object | NotInlinable returns false for has_inlined_type_constraint'
 160     );
 161 }
 162
 163 {
 164     my $iunion = Moose::Util::TypeConstraints::find_or_create_type_constraint(
 165         'Object | Inlinable | CodeRef');
 166
 167     ok(
 168         $iunion->has_inlined_type_constraint,
 169         'Object | Inlinable | CodeRef returns true for has_inlined_type_constraint'
 170     );
 171
 172     is(
 173         $iunion->_inline_check('$foo'),
 174         q{(Scalar::Util::blessed( $foo )) || (defined $foo && ! ref $foo && $foo !~ /Q/) || (ref $foo eq 'CODE')},
 175         'got expected inline code for Object | Inlinable | CodeRef constraint'
 176     );
 177
 178     my $niunion = Moose::Util::TypeConstraints::find_or_create_type_constraint(
 179         'Object | NotInlinable | CodeRef');
 180
 181     ok(
 182         !$niunion->has_inlined_type_constraint,
 183         'Object | NotInlinable | CodeRef returns false for has_inlined_type_constraint'
 184     );
 185 }
 186
 187 done_testing;