File Coverage

blib/lib/Data/Sah/Compiler/perl/TH/bool.pm
Criterion Covered Total %
statement 46 48 95.8
branch 18 22 81.8
condition n/a
subroutine 9 9 100.0
pod 0 4 0.0
total 73 83 87.9


line stmt bran cond sub pod time code
1              
2             use 5.010;
3 3     3   53 use strict;
  3         9  
4 3     3   12 use warnings;
  3         6  
  3         62  
5 3     3   13 #use Log::Any '$log';
  3         6  
  3         83  
6              
7             use Mo qw(build default);
8 3     3   13 use Role::Tiny::With;
  3         4  
  3         14  
9 3     3   666  
  3         7  
  3         1786  
10             extends 'Data::Sah::Compiler::perl::TH';
11             with 'Data::Sah::Type::bool';
12              
13             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
14             our $DATE = '2022-08-20'; # DATE
15             our $DIST = 'Data-Sah'; # DIST
16             our $VERSION = '0.912'; # VERSION
17              
18             my ($self, $cd) = @_;
19             my $c = $self->compiler;
20 355     355 0 594  
21 355         1238 my $dt = $cd->{data_term};
22             $cd->{_ccl_check_type} = "!ref($dt)";
23 355         1469 }
24 355         995  
25             my ($self, $which, $cd) = @_;
26             my $c = $self->compiler;
27             my $ct = $cd->{cl_term};
28 289     289 0 475 my $dt = $cd->{data_term};
29 289         801  
30 289         1128 if ($which eq 'is') {
31 289         451 $c->add_ccl($cd, "($dt ? 1:0) == ($ct ? 1:0)");
32             } elsif ($which eq 'in') {
33 289 100       674 if ($dt =~ /\$_\b/) {
    50          
34 150         523 $c->add_ccl($cd, "do { my \$_sahv_dt = $dt; (grep { (\$_ ? 1:0) == (\$_sahv_dt ? 1:0) } \@{ $ct }) ? 1:0 }");
35             } else {
36 139 100       306 $c->add_ccl($cd, "(grep { (\$_ ? 1:0) == ($dt ? 1:0) } \@{ $ct }) ? 1:0");
37 1         5 }
38             }
39 138         497 }
40              
41             my ($self, $which, $cd) = @_;
42             my $c = $self->compiler;
43             my $cv = $cd->{cl_value};
44             my $ct = $cd->{cl_term};
45 60     60 0 129 my $dt = $cd->{data_term};
46 60         143  
47 60         249 if ($which eq 'min') {
48 60         87 $c->add_ccl($cd, "($dt ? 1:0) >= ($ct ? 1:0)");
49 60         85 } elsif ($which eq 'xmin') {
50             $c->add_ccl($cd, "($dt ? 1:0) > ($ct ? 1:0)");
51 60 100       254 } elsif ($which eq 'max') {
    100          
    100          
    100          
    100          
    50          
52 9         30 $c->add_ccl($cd, "($dt ? 1:0) <= ($ct ? 1:0)");
53             } elsif ($which eq 'xmax') {
54 9         33 $c->add_ccl($cd, "($dt ? 1:0) < ($ct ? 1:0)");
55             } elsif ($which eq 'between') {
56 9         32 if ($cd->{cl_is_expr}) {
57             $c->add_ccl($cd, "($dt ? 1:0) >= ($ct\->[0] ? 1:0) && ".
58 9         29 "($dt ? 1:0) <= ($ct\->[1] ? 1:0)");
59             } else {
60 12 50       25 # simplify code
61 0         0 $c->add_ccl($cd, "($dt ? 1:0) >= ($cv->[0] ? 1:0) && ".
62             "($dt ? 1:0) <= ($cv->[1] ? 1:0)");
63             }
64             } elsif ($which eq 'xbetween') {
65 12         59 if ($cd->{cl_is_expr}) {
66             $c->add_ccl($cd, "($dt ? 1:0) > ($ct\->[0] ? 1:0) && ".
67             "($dt ? 1:0) < ($ct\->[1] ? 1:0)");
68             } else {
69 12 50       23 # simplify code
70 0         0 $c->add_ccl($cd, "($dt ? 1:0) > ($cv->[0] ? 1:0) && ".
71             "($dt ? 1:0) < ($cv->[1] ? 1:0)");
72             }
73             }
74 12         56 }
75              
76             my ($self, $cd) = @_;
77             my $c = $self->compiler;
78             my $ct = $cd->{cl_term};
79             my $dt = $cd->{data_term};
80              
81 21     21 0 63 $c->add_ccl($cd, "($ct) ? $dt : !defined($ct) ? 1 : !$dt");
82 21         54 }
83 21         84  
84 21         33 1;
85             # ABSTRACT: perl's type handler for type "bool"
86 21         69  
87              
88             =pod
89              
90             =encoding UTF-8
91              
92             =head1 NAME
93              
94             Data::Sah::Compiler::perl::TH::bool - perl's type handler for type "bool"
95              
96             =head1 VERSION
97              
98             This document describes version 0.912 of Data::Sah::Compiler::perl::TH::bool (from Perl distribution Data-Sah), released on 2022-08-20.
99              
100             =for Pod::Coverage ^(clause_.+|superclause_.+)$
101              
102             =head1 HOMEPAGE
103              
104             Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah>.
105              
106             =head1 SOURCE
107              
108             Source repository is at L<https://github.com/perlancar/perl-Data-Sah>.
109              
110             =head1 AUTHOR
111              
112             perlancar <perlancar@cpan.org>
113              
114             =head1 CONTRIBUTING
115              
116              
117             To contribute, you can send patches by email/via RT, or send pull requests on
118             GitHub.
119              
120             Most of the time, you don't need to build the distribution yourself. You can
121             simply modify the code, then test via:
122              
123             % prove -l
124              
125             If you want to build the distribution (e.g. to try to install it locally on your
126             system), you can install L<Dist::Zilla>,
127             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
128             L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
129             Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
130             that are considered a bug and can be reported to me.
131              
132             =head1 COPYRIGHT AND LICENSE
133              
134             This software is copyright (c) 2022, 2021, 2020, 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012 by perlancar <perlancar@cpan.org>.
135              
136             This is free software; you can redistribute it and/or modify it under
137             the same terms as the Perl 5 programming language system itself.
138              
139             =head1 BUGS
140              
141             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah>
142              
143             When submitting a bug or request, please include a test-file or a
144             patch to an existing test-file that illustrates the bug or desired
145             feature.
146              
147             =cut