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   2289 use strict;
  7         20  
4 7     7   39 use warnings;
  7         22  
  7         123  
5 7     7   27 #use Log::Any '$log';
  7         12  
  7         204  
6              
7             use Mo qw(build default);
8 7     7   32 use Role::Tiny::With;
  7         22  
  7         34  
9 7     7   1724  
  7         13  
  7         4053  
10             extends 'Data::Sah::Compiler::perl::TH';
11             with 'Data::Sah::Type::num';
12              
13             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
14             our $DATE = '2022-09-30'; # DATE
15             our $DIST = 'Data-Sah'; # DIST
16             our $VERSION = '0.913'; # VERSION
17              
18             my ($self, $cd) = @_;
19             my $c = $self->compiler;
20 494     494 0 865 my $dt = $cd->{data_term};
21 494         1549  
22 494         2122 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     2216 } else {
25 16         45 $c->add_sun_module($cd);
26             $cd->{_ccl_check_type} = "$cd->{_sun_module}::isnum($dt)";
27 478         1666 }
28 478         2065 }
29              
30             my ($self, $which, $cd) = @_;
31             my $c = $self->compiler;
32             my $ct = $cd->{cl_term};
33 829     829 0 2277 my $dt = $cd->{data_term};
34 829         2535  
35 829         3615 if ($which eq 'is') {
36 829         1457 $c->add_ccl($cd, "$dt == $ct");
37             } elsif ($which eq 'in') {
38 829 100       2203 if ($dt =~ /\$_\b/) {
    50          
39 414         1745 $c->add_ccl($cd, "do { my \$_sahv_dt = $dt; grep { \$_ == \$_sahv_dt } \@{ $ct } }");
40             } else {
41 415 100       1151 $c->add_ccl($cd, "grep { \$_ == $dt } \@{ $ct }");
42 1         4 }
43             }
44 414         1743 }
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 1814 my $dt = $cd->{data_term};
51 755         2702  
52 755         3295 if ($which eq 'min') {
53 755         1325 $c->add_ccl($cd, "$dt >= $ct");
54 755         1790 } elsif ($which eq 'xmin') {
55             $c->add_ccl($cd, "$dt > $ct");
56 755 100       3566 } elsif ($which eq 'max') {
    100          
    100          
    100          
    100          
    50          
57 127         606 $c->add_ccl($cd, "$dt <= $ct");
58             } elsif ($which eq 'xmax') {
59 27         111 $c->add_ccl($cd, "$dt < $ct");
60             } elsif ($which eq 'between') {
61 82         342 if ($cd->{cl_is_expr}) {
62             $c->add_ccl($cd, "$dt >= $ct\->[0] && $dt <= $ct\->[1]");
63 51         218 } else {
64             # simplify code
65 432 50       874 $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         2469 $c->add_ccl($cd, "$dt > $ct\->[0] && $dt < $ct\->[1]");
70             } else {
71             # simplify code
72 36 50       96 $c->add_ccl($cd, "$dt > $cv->[0] && $dt < $cv->[1]");
73 0         0 }
74             }
75             }
76 36         259  
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.913 of Data::Sah::Compiler::perl::TH::num (from Perl distribution Data-Sah), released on 2022-09-30.
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