File Coverage

blib/lib/Data/Sah/Compiler/perl/TH/num.pm
Criterion Covered Total %
statement 44 46 95.6
branch 20 24 83.3
condition 3 3 100.0
subroutine 8 8 100.0
pod 0 3 0.0
total 75 84 89.2


line stmt bran cond sub pod time code
1              
2             use 5.010;
3 7     7   2227 use strict;
  7         22  
4 7     7   37 use warnings;
  7         19  
  7         121  
5 7     7   26 #use Log::Any '$log';
  7         11  
  7         205  
6              
7             use Mo qw(build default);
8 7     7   34 use Role::Tiny::With;
  7         10  
  7         29  
9 7     7   1669  
  7         13  
  7         3908  
10             extends 'Data::Sah::Compiler::perl::TH';
11             with 'Data::Sah::Type::num';
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 494     494 0 1293 my $dt = $cd->{data_term};
21 494         1847  
22 494         2459 if ($cd->{args}{core} || $cd->{args}{no_modules}) {
23             $cd->{_ccl_check_type} = "$dt =~ ".'/\A(?:[+-]?(?:0|[1-9][0-9]*)(\.[0-9]+)?([eE][+-]?[0-9]+)?|((?i)\s*nan\s*)|((?i)\s*[+-]?inf(inity)?)\s*)\z/';
24 494 100 100     3519 } else {
25 16         45 $c->add_sun_module($cd);
26             $cd->{_ccl_check_type} = "$cd->{_sun_module}::isnum($dt)";
27 478         2269 }
28 478         2634 }
29              
30             my ($self, $which, $cd) = @_;
31             my $c = $self->compiler;
32             my $ct = $cd->{cl_term};
33 829     829 0 1767 my $dt = $cd->{data_term};
34 829         2502  
35 829         3498 if ($which eq 'is') {
36 829         1597 $c->add_ccl($cd, "$dt == $ct");
37             } elsif ($which eq 'in') {
38 829 100       2371 if ($dt =~ /\$_\b/) {
    50          
39 414         1772 $c->add_ccl($cd, "do { my \$_sahv_dt = $dt; grep { \$_ == \$_sahv_dt } \@{ $ct } }");
40             } else {
41 415 100       1046 $c->add_ccl($cd, "grep { \$_ == $dt } \@{ $ct }");
42 1         5 }
43             }
44 414         1559 }
45              
46             my ($self, $which, $cd) = @_;
47             my $c = $self->compiler;
48             my $cv = $cd->{cl_value};
49             my $ct = $cd->{cl_term};
50 755     755 0 1645 my $dt = $cd->{data_term};
51 755         1942  
52 755         3292 if ($which eq 'min') {
53 755         1214 $c->add_ccl($cd, "$dt >= $ct");
54 755         1592 } elsif ($which eq 'xmin') {
55             $c->add_ccl($cd, "$dt > $ct");
56 755 100       3360 } elsif ($which eq 'max') {
    100          
    100          
    100          
    100          
    50          
57 127         527 $c->add_ccl($cd, "$dt <= $ct");
58             } elsif ($which eq 'xmax') {
59 27         122 $c->add_ccl($cd, "$dt < $ct");
60             } elsif ($which eq 'between') {
61 82         299 if ($cd->{cl_is_expr}) {
62             $c->add_ccl($cd, "$dt >= $ct\->[0] && $dt <= $ct\->[1]");
63 51         201 } else {
64             # simplify code
65 432 50       965 $c->add_ccl($cd, "$dt >= $cv->[0] && $dt <= $cv->[1]");
66 0         0 }
67             } elsif ($which eq 'xbetween') {
68             if ($cd->{cl_is_expr}) {
69 432         2379 $c->add_ccl($cd, "$dt > $ct\->[0] && $dt < $ct\->[1]");
70             } else {
71             # simplify code
72 36 50       105 $c->add_ccl($cd, "$dt > $cv->[0] && $dt < $cv->[1]");
73 0         0 }
74             }
75             }
76 36         263  
77             1;
78             # ABSTRACT: perl's type handler for type "num"
79              
80              
81             =pod
82              
83             =encoding UTF-8
84              
85             =head1 NAME
86              
87             Data::Sah::Compiler::perl::TH::num - perl's type handler for type "num"
88              
89             =head1 VERSION
90              
91             This document describes version 0.914 of Data::Sah::Compiler::perl::TH::num (from Perl distribution Data-Sah), released on 2022-10-19.
92              
93             =for Pod::Coverage ^(clause_.+|superclause_.+)$
94              
95             =head1 HOMEPAGE
96              
97             Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah>.
98              
99             =head1 SOURCE
100              
101             Source repository is at L<https://github.com/perlancar/perl-Data-Sah>.
102              
103             =head1 AUTHOR
104              
105             perlancar <perlancar@cpan.org>
106              
107             =head1 CONTRIBUTING
108              
109              
110             To contribute, you can send patches by email/via RT, or send pull requests on
111             GitHub.
112              
113             Most of the time, you don't need to build the distribution yourself. You can
114             simply modify the code, then test via:
115              
116             % prove -l
117              
118             If you want to build the distribution (e.g. to try to install it locally on your
119             system), you can install L<Dist::Zilla>,
120             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
121             L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
122             Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
123             that are considered a bug and can be reported to me.
124              
125             =head1 COPYRIGHT AND LICENSE
126              
127             This software is copyright (c) 2022, 2021, 2020, 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012 by perlancar <perlancar@cpan.org>.
128              
129             This is free software; you can redistribute it and/or modify it under
130             the same terms as the Perl 5 programming language system itself.
131              
132             =head1 BUGS
133              
134             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah>
135              
136             When submitting a bug or request, please include a test-file or a
137             patch to an existing test-file that illustrates the bug or desired
138             feature.
139              
140             =cut