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   60 use strict;
  3         8  
4 3     3   14 use warnings;
  3         5  
  3         61  
5 3     3   13 #use Log::Any '$log';
  3         6  
  3         75  
6              
7             use Mo qw(build default);
8 3     3   14 use Role::Tiny::With;
  3         6  
  3         22  
9 3     3   674  
  3         6  
  3         1799  
10             extends 'Data::Sah::Compiler::perl::TH';
11             with 'Data::Sah::Type::bool';
12              
13             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
14             our $DATE = '2022-10-19'; # DATE
15             our $DIST = 'Data-Sah'; # DIST
16             our $VERSION = '0.914'; # VERSION
17              
18             my ($self, $cd) = @_;
19             my $c = $self->compiler;
20 355     355 0 679  
21 355         1167 my $dt = $cd->{data_term};
22             $cd->{_ccl_check_type} = "!ref($dt)";
23 355         1627 }
24 355         1387  
25             my ($self, $which, $cd) = @_;
26             my $c = $self->compiler;
27             my $ct = $cd->{cl_term};
28 289     289 0 564 my $dt = $cd->{data_term};
29 289         840  
30 289         1245 if ($which eq 'is') {
31 289         590 $c->add_ccl($cd, "($dt ? 1:0) == ($ct ? 1:0)");
32             } elsif ($which eq 'in') {
33 289 100       807 if ($dt =~ /\$_\b/) {
    50          
34 150         558 $c->add_ccl($cd, "do { my \$_sahv_dt = $dt; (grep { (\$_ ? 1:0) == (\$_sahv_dt ? 1:0) } \@{ $ct }) ? 1:0 }");
35             } else {
36 139 100       370 $c->add_ccl($cd, "(grep { (\$_ ? 1:0) == ($dt ? 1:0) } \@{ $ct }) ? 1:0");
37 1         5 }
38             }
39 138         522 }
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 138 my $dt = $cd->{data_term};
46 60         177  
47 60         257 if ($which eq 'min') {
48 60         118 $c->add_ccl($cd, "($dt ? 1:0) >= ($ct ? 1:0)");
49 60         102 } elsif ($which eq 'xmin') {
50             $c->add_ccl($cd, "($dt ? 1:0) > ($ct ? 1:0)");
51 60 100       247 } elsif ($which eq 'max') {
    100          
    100          
    100          
    100          
    50          
52 9         32 $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         36 if ($cd->{cl_is_expr}) {
57             $c->add_ccl($cd, "($dt ? 1:0) >= ($ct\->[0] ? 1:0) && ".
58 9         33 "($dt ? 1:0) <= ($ct\->[1] ? 1:0)");
59             } else {
60 12 50       24 # 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         66 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       25 # 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         60 }
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 48 $c->add_ccl($cd, "($ct) ? $dt : !defined($ct) ? 1 : !$dt");
82 21         58 }
83 21         89  
84 21         34 1;
85             # ABSTRACT: perl's type handler for type "bool"
86 21         82  
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.914 of Data::Sah::Compiler::perl::TH::bool (from Perl distribution Data-Sah), released on 2022-10-19.
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