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   2240 use strict;
  7         21  
4 7     7   31 use warnings;
  7         11  
  7         148  
5 7     7   30 #use Log::Any '$log';
  7         10  
  7         182  
6              
7             use Mo qw(build default);
8 7     7   30 use Role::Tiny::With;
  7         48  
  7         39  
9 7     7   1631  
  7         11  
  7         3974  
10             extends 'Data::Sah::Compiler::perl::TH';
11             with 'Data::Sah::Type::num';
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 494     494 0 1275 my $dt = $cd->{data_term};
21 494         2296  
22 494         2541 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     3431 } else {
25 16         45 $c->add_sun_module($cd);
26             $cd->{_ccl_check_type} = "$cd->{_sun_module}::isnum($dt)";
27 478         2472 }
28 478         2555 }
29              
30             my ($self, $which, $cd) = @_;
31             my $c = $self->compiler;
32             my $ct = $cd->{cl_term};
33 829     829 0 1615 my $dt = $cd->{data_term};
34 829         2581  
35 829         3428 if ($which eq 'is') {
36 829         1447 $c->add_ccl($cd, "$dt == $ct");
37             } elsif ($which eq 'in') {
38 829 100       2399 if ($dt =~ /\$_\b/) {
    50          
39 414         1619 $c->add_ccl($cd, "do { my \$_sahv_dt = $dt; grep { \$_ == \$_sahv_dt } \@{ $ct } }");
40             } else {
41 415 100       1040 $c->add_ccl($cd, "grep { \$_ == $dt } \@{ $ct }");
42 1         4 }
43             }
44 414         1811 }
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 1827 my $dt = $cd->{data_term};
51 755         2984  
52 755         3316 if ($which eq 'min') {
53 755         1745 $c->add_ccl($cd, "$dt >= $ct");
54 755         1340 } elsif ($which eq 'xmin') {
55             $c->add_ccl($cd, "$dt > $ct");
56 755 100       3964 } elsif ($which eq 'max') {
    100          
    100          
    100          
    100          
    50          
57 127         579 $c->add_ccl($cd, "$dt <= $ct");
58             } elsif ($which eq 'xmax') {
59 27         147 $c->add_ccl($cd, "$dt < $ct");
60             } elsif ($which eq 'between') {
61 82         360 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       1071 $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         2725 $c->add_ccl($cd, "$dt > $ct\->[0] && $dt < $ct\->[1]");
70             } else {
71             # simplify code
72 36 50       116 $c->add_ccl($cd, "$dt > $cv->[0] && $dt < $cv->[1]");
73 0         0 }
74             }
75             }
76 36         299  
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.912 of Data::Sah::Compiler::perl::TH::num (from Perl distribution Data-Sah), released on 2022-08-20.
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