File Coverage

blib/lib/MOP/Slot/Initializer.pm
Criterion Covered Total %
statement 28 28 100.0
branch 5 6 83.3
condition 4 6 66.6
subroutine 9 9 100.0
pod 3 3 100.0
total 49 52 94.2


line stmt bran cond sub pod time code
1             package MOP::Slot::Initializer;
2             # ABSTRACT: A representation of a class slot initializer
3              
4 8     8   1324 use strict;
  8         13  
  8         196  
5 8     8   30 use warnings;
  8         12  
  8         151  
6              
7 8     8   29 use Carp ();
  8         13  
  8         97  
8              
9 8     8   34 use MOP::Internal::Util;
  8         23  
  8         396  
10              
11             our $VERSION = '0.14';
12             our $AUTHORITY = 'cpan:STEVAN';
13              
14 8     8   53 use parent 'UNIVERSAL::Object::Immutable';
  8         13  
  8         39  
15              
16             our %HAS; BEGIN {
17             %HAS = (
18             default => sub {},
19             required => sub {},
20             )
21 8     8   2297 }
22              
23             sub BUILDARGS {
24 4     4 1 9237 my $class = shift;
25 4         19 my $args = $class->SUPER::BUILDARGS( @_ );
26              
27             Carp::confess('Cannot have both a default and be required in the same initializer')
28 4 50 66     43 if $args->{default} && $args->{required};
29              
30 4         8 return $args;
31             }
32              
33             sub CREATE {
34 4     4 1 40 my ($class, $args) = @_;
35              
36 4         9 my $code;
37 4 100       9 if ( my $message = $args->{required} ) {
38 1         65 $code = eval 'sub { die \''.$message.'\' }';
39             }
40             else {
41 3   66     151 $code = $args->{default} || eval 'sub { undef }';
42             }
43              
44 4         17 return $code;
45             }
46              
47             sub BUILD {
48 4     4 1 149 my ($self, $params) = @_;
49              
50             MOP::Internal::Util::SET_COMP_STASH_FOR_CV( $self, $params->{within_package} )
51 4 100       23 if $params->{within_package};
52             }
53              
54             1;
55              
56             __END__