4da7dde44

Build Type

push

github-actions

Committed by GitHub

Commit Message

<a href="https://github.com/tobyink/p5-type-tiny/commit/<a class=hub.com/tobyink/p5-type-tiny/commit/4da7dde4473575263508c6f0c99bace9e2ab7f87">4da7dde44<a href="https://github.com/tobyink/p5-type-tiny/commit/4da7dde4473575263508c6f0c99bace9e2ab7f87">">Merge </a><a class="double-link" href="https://github.com/tobyink/p5-type-tiny/commit/<a class="double-link" href="https://github.com/tobyink/p5-type-tiny/commit/6c1588ac1d3066596a011daee00094ffdee2b635">6c1588ac1</a>">6c1588ac1</a><a href="https://github.com/tobyink/p5-type-tiny/commit/4da7dde4473575263508c6f0c99bace9e2ab7f87"> into d5248b7b1">d5248b7b1</a>

Run Details

60 of 60 new or added lines in 1 file covered. (100.0%)

3577 of 3580 relevant lines covered (99.92%)

28953.08 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

95.0

/lib/Type/Tiny/Bitfield.pm

package Type::Tiny::Bitfield;

use 5.008001;
use strict;
use warnings;

BEGIN {
        $Type::Tiny::Bitfield::AUTHORITY = 'cpan:TOBYINK';
        $Type::Tiny::Bitfield::VERSION   = '2.002001';
}

$Type::Tiny::Bitfield::VERSION =~ tr/_//d;

sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }

use Exporter::Tiny 1.004001 ();
use Type::Tiny ();
use Types::Common::Numeric qw( +PositiveOrZeroInt );

our @ISA = qw( Type::Tiny Exporter::Tiny );

sub _is_power_of_two { not $_[0] & $_[0]-1 }

sub _exporter_fail {
        my ( $class, $type_name, $values, $globals ) = @_;
        my $caller = $globals->{into};
        my $type = $class->new(
                name      => $type_name,
                values    => { %$values },
                #coercion  => 1,
        );
        $INC{'Type/Registry.pm'}
                ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name )
                : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type )
                unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} );
        return map +( $_->{name} => $_->{code} ), @{ $type->exportables };
}

sub new {
        my $proto = shift;
        
        my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_;
        _croak
                "Bitfield type constraints cannot have a parent constraint passed to the constructor"
                if exists $opts{parent};
        _croak
                "Bitfield type constraints cannot have a constraint coderef passed to the constructor"
                if exists $opts{constraint};
        _croak
                "Bitfield type constraints cannot have a inlining coderef passed to the constructor"
                if exists $opts{inlined};
        _croak "Need to supply hashref of values"
                unless exists $opts{values};
        
        $opts{parent} = PositiveOrZeroInt;
        
        for my $key ( keys %{ $opts{values} } ) {
                _croak "Not an all-caps name in a bitfield: $key"
                        unless $key =~ /^[A-Z][A-Z0-9]*(_[A-Z0-9]+)*/
        }
        my $ALL = 0;
        my %already = ();
        for my $value ( values %{ $opts{values} } ) {
                _croak "Not a positive power of 2 in a bitfield: $value"
                        unless is_PositiveOrZeroInt( $value ) && _is_power_of_two( $value );
                _croak "Duplicate value in a bitfield: $value"
                        if $already{$value}++;
                $ALL |= ( 0 + $value );
        }
        $opts{ALL} = $ALL;
        
        $opts{constraint} = sub {
                not shift() & ~$ALL;
        };
        
        # TODO: coercion. Should accept strings like 'RED|green|Blue' and
        # turn it into an integer.
        
        return $proto->SUPER::new( %opts );
} #/ sub new

sub values {
        $_[0]{values}
}

sub _lockdown {
        my ( $self, $callback ) = @_;
        $callback->( $self->{values} );
}

sub exportables {
        my ( $self, $base_name ) = @_;
        if ( not $self->is_anon ) {
                $base_name ||= $self->name;
        }
        
        my $exportables = $self->SUPER::exportables( $base_name );
        
        require Eval::TypeTiny;
        require B;
        
        for my $key ( keys %{ $self->values } ) {
                my $value = $self->values->{$key};
                push @$exportables, {
                        name => uc( sprintf '%s_%s', $base_name, $key ),
                        tags => [ 'constants' ],
                        code => Eval::TypeTiny::eval_closure(
                                source      => sprintf( 'sub () { %d }', $value ),
                                environment => {},
                        ),
                };
        }
        
        # TODO: maybe export a `from_LineStyle` function which converts a
        # linestyle (or whatever bitfield) back into a string?
        
        return $exportables;
}

sub can_be_inlined {
        !!1;
}

sub inline_check {
        my ( $self, $var ) = @_;
        
        return sprintf(
                '( %s and not %s & ~%d )',
                PositiveOrZeroInt->inline_check( $var ),
                $var,
                $self->{ALL},
        );
}

sub AUTOLOAD {
        my $self = shift;
        my ( $m ) = ( our $AUTOLOAD =~ /::(\w+)$/ );
        return if $m eq 'DESTROY';
        if ( ref $self and exists $self->{values}{$m} ) {
                return 0 + $self->{values}{$m};
        }
        return $self->SUPER::AUTOLOAD( @_ );
}

sub can {
        my ( $self, $m ) = ( shift, @_ );
        if ( ref $self and exists $self->{values}{$m} ) {
                return sub () { 0 + $self->{values}{$m} };
        }
        return $self->SUPER::can( @_ );
}

1;

1	package Type::Tiny::Bitfield;
2
3	use 5.008001;	8✔
4	use strict;	8✔
5	use warnings;	8✔
6
7	BEGIN {
8	$Type::Tiny::Bitfield::AUTHORITY = 'cpan:TOBYINK';	8✔
9	$Type::Tiny::Bitfield::VERSION = '2.002001';	8✔
10	}
11
12	$Type::Tiny::Bitfield::VERSION =~ tr/_//d;
13
14	sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }	16✔
15
16	use Exporter::Tiny 1.004001 ();	8✔
17	use Type::Tiny ();	8✔
18	use Types::Common::Numeric qw( +PositiveOrZeroInt );	8✔
19
20	our @ISA = qw( Type::Tiny Exporter::Tiny );
21
22	sub _is_power_of_two { not $_[0] & $_[0]-1 }	51✔
23
24	sub _exporter_fail {
25	my ( $class, $type_name, $values, $globals ) = @_;	24✔
26	my $caller = $globals->{into};	24✔
27	my $type = $class->new(	24✔
28	name => $type_name,
29	values => { %$values },
30	#coercion => 1,
31	);
32	$INC{'Type/Registry.pm'}
33	? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name )
34	: ( $Type::Registry::DELAYED{$caller}{$type_name} = $type )
35	unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} );	8✔
36	return map +( $_->{name} => $_->{code} ), @{ $type->exportables };	8✔
37	}
38
39	sub new {
40	my $proto = shift;	24✔
41
42	my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_;	24✔
43	_croak
44	"Bitfield type constraints cannot have a parent constraint passed to the constructor"
45	if exists $opts{parent};	24✔
46	_croak
47	"Bitfield type constraints cannot have a constraint coderef passed to the constructor"
48	if exists $opts{constraint};	24✔
49	_croak
50	"Bitfield type constraints cannot have a inlining coderef passed to the constructor"
51	if exists $opts{inlined};	24✔
52	_croak "Need to supply hashref of values"
53	unless exists $opts{values};	24✔
54
55	$opts{parent} = PositiveOrZeroInt;	24✔
56
57	for my $key ( keys %{ $opts{values} } ) {	24✔
58	_croak "Not an all-caps name in a bitfield: $key"	72✔
59	unless $key =~ /^[A-Z][A-Z0-9](_[A-Z0-9]+)/
60	}
61	my $ALL = 0;	16✔
62	my %already = ();	16✔
63	for my $value ( values %{ $opts{values} } ) {	16✔
64	_croak "Not a positive power of 2 in a bitfield: $value"	51✔
65	unless is_PositiveOrZeroInt( $value ) && _is_power_of_two( $value );
66	_croak "Duplicate value in a bitfield: $value"
67	if $already{$value}++;	43✔
68	$ALL \|= ( 0 + $value );	43✔
69	}
70	$opts{ALL} = $ALL;	8✔
71
72	$opts{constraint} = sub {
73	not shift() & ~$ALL;	×
74	};	8✔
75
76	# TODO: coercion. Should accept strings like 'RED\|green\|Blue' and
77	# turn it into an integer.
78
79	return $proto->SUPER::new( %opts );	8✔
80	} #/ sub new
81
82	sub values {
83	$_[0]{values}
84	}	40✔
85
86	sub _lockdown {
87	my ( $self, $callback ) = @_;	8✔
88	$callback->( $self->{values} );	8✔
89	}
90
91	sub exportables {
92	my ( $self, $base_name ) = @_;	8✔
93	if ( not $self->is_anon ) {	8✔
94	$base_name \|\|= $self->name;	8✔
95	}
96
97	my $exportables = $self->SUPER::exportables( $base_name );	8✔
98
99	require Eval::TypeTiny;	8✔
100	require B;	8✔
101
102	for my $key ( keys %{ $self->values } ) {	8✔
103	my $value = $self->values->{$key};	32✔
104	push @$exportables, {	32✔
105	name => uc( sprintf '%s_%s', $base_name, $key ),
106	tags => [ 'constants' ],
107	code => Eval::TypeTiny::eval_closure(
108	source => sprintf( 'sub () { %d }', $value ),
109	environment => {},
110	),
111	};
112	}
113
114	# TODO: maybe export a `from_LineStyle` function which converts a
115	# linestyle (or whatever bitfield) back into a string?
116
117	return $exportables;	8✔
118	}
119
120	sub can_be_inlined {
121	!!1;	32✔
122	}
123
124	sub inline_check {
125	my ( $self, $var ) = @_;	24✔
126
127	return sprintf(
128	'( %s and not %s & ~%d )',
129	PositiveOrZeroInt->inline_check( $var ),
130	$var,
131	$self->{ALL},
132	);	24✔
133	}
134
135	sub AUTOLOAD {
136	my $self = shift;	32✔
137	my ( $m ) = ( our $AUTOLOAD =~ /::(\w+)$/ );	32✔
138	return if $m eq 'DESTROY';	32✔
139	if ( ref $self and exists $self->{values}{$m} ) {	32✔
140	return 0 + $self->{values}{$m};	32✔
141	}
142	return $self->SUPER::AUTOLOAD( @_ );	×
143	}
144
145	sub can {
146	my ( $self, $m ) = ( shift, @_ );	8✔
147	if ( ref $self and exists $self->{values}{$m} ) {	8✔
148	return sub () { 0 + $self->{values}{$m} };	×
149	}
150	return $self->SUPER::can( @_ );	8✔
151	}
152
153	1;

tobyink / p5-type-tiny / 4da7dde44

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous