File Coverage

blib/lib/RPerl/DataType/Number.pm
Criterion Covered Total %
statement 88 124 70.9
branch 16 26 61.5
condition 3 6 50.0
subroutine 19 24 79.1
pod n/a
total 126 180 70.0


line stmt bran cond sub pod time code
1             # [[[ HEADER ]]]
2             package RPerl::DataType::Number;
3 7     7   43 use strict;
  7         15  
  7         185  
4 7     7   31 use warnings;
  7         15  
  7         166  
5 7     7   32 use RPerl::AfterSubclass;
  7         14  
  7         1069  
6             our $VERSION = 0.013_000;
7              
8             # [[[ OO INHERITANCE ]]]
9 7     7   43 use parent qw(RPerl::DataType::Scalar);
  7         12  
  7         34  
10 7     7   382 use RPerl::DataType::Scalar;
  7         12  
  7         173  
11              
12             # [[[ CRITICS ]]]
13             ## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls) # USER DEFAULT 1: allow numeric values & print operator
14             ## no critic qw(RequireInterpolationOfMetachars) # USER DEFAULT 2: allow single-quoted control characters & sigils
15             ## no critic qw(Capitalization ProhibitMultiplePackages ProhibitReusedNames) # SYSTEM DEFAULT 3: allow multiple & lower case package names
16              
17             # [[[ SUB-TYPES ]]]
18             # DEV NOTE, CORRELATION #rp007:
19             # a number is any numeric value, meaning either an integer or a floating-point number;
20             # Boolean, Unsigned Integer, and Integer are all sub-classes of Number;
21             # the hidden Perl semantics are SvIOKp() for ints, and SvNOKp() for numbers;
22             # these numbers appear to act as C doubles and are implemented as such in RPerl;
23             # in the future, this can be optimized (for at least memory usage) by implementing full Float semantics
24             package # hide from PAUSE indexing
25             number;
26 7     7   30 use strict;
  7         13  
  7         126  
27 7     7   29 use warnings;
  7         10  
  7         185  
28 7     7   33 use parent qw(RPerl::DataType::Number);
  7         12  
  7         28  
29              
30             package # hide from PAUSE indexing
31             constant_number;
32 7     7   429 use strict;
  7         17  
  7         111  
33 7     7   28 use warnings;
  7         12  
  7         160  
34 7     7   31 use parent qw(RPerl::DataType::Number);
  7         11  
  7         20  
35              
36             # [[[ PRE-DECLARED TYPES ]]]
37             package # hide from PAUSE indexing
38             boolean;
39             package # hide from PAUSE indexing
40             unsigned_integer;
41             package # hide from PAUSE indexing
42             integer;
43             package # hide from PAUSE indexing
44             character;
45             package # hide from PAUSE indexing
46             string;
47              
48             # [[[ SWITCH CONTEXT BACK TO PRIMARY PACKAGE ]]]
49             package RPerl::DataType::Number;
50 7     7   433 use strict;
  7         15  
  7         133  
51 7     7   31 use warnings;
  7         11  
  7         176  
52              
53             # [[[ INCLUDES ]]]
54 7     7   53 use POSIX qw(floor);
  7         12  
  7         46  
55              
56             # [[[ EXPORTS ]]]
57 7     7   499 use RPerl::Exporter 'import';
  7         15  
  7         43  
58             our @EXPORT = qw(number_CHECK number_CHECKTRACE number_to_boolean number_to_unsigned_integer number_to_integer number_to_character number_to_string);
59             our @EXPORT_OK = qw(number__typetest0 number__typetest1);
60              
61             # [[[ TYPE-CHECKING ]]]
62             sub number_CHECK {
63 0     0   0 { my void $RETURN_TYPE };
  0         0  
64 0         0 ( my $possible_number ) = @ARG;
65 0 0       0 if ( not( defined $possible_number ) ) {
66             # croak( "\nERROR ENV00, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\nnumber value expected but undefined/null value found,\ncroaking" );
67 0         0 die( "\nERROR ENV00, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\nnumber value expected but undefined/null value found,\ndying\n" );
68             }
69 0 0 0     0 if (not( main::RPerl_SvNOKp($possible_number)
70             || main::RPerl_SvIOKp($possible_number) ) )
71             {
72             # croak( "\nERROR ENV01, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\nnumber value expected but non-number value found,\ncroaking" );
73 0         0 die( "\nERROR ENV01, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\nnumber value expected but non-number value found,\ndying\n" );
74             }
75 0         0 return;
76             }
77             sub number_CHECKTRACE {
78 78     78   103 { my void $RETURN_TYPE };
  78         96  
79 78         178 ( my $possible_number, my $variable_name, my $subroutine_name ) = @ARG;
80 78 100       147 if ( not( defined $possible_number ) ) {
81             # croak( "\nERROR ENV00, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\nnumber value expected but undefined/null value found,\nin variable $variable_name from subroutine $subroutine_name,\ncroaking" );
82 4         37 die( "\nERROR ENV00, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\nnumber value expected but undefined/null value found,\nin variable $variable_name from subroutine $subroutine_name,\ndying\n" );
83             }
84 74 100 100     240 if (not( main::RPerl_SvNOKp($possible_number)
85             || main::RPerl_SvIOKp($possible_number) )
86             )
87             {
88             # croak( "\nERROR ENV01, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\nnumber value expected but non-number value found,\nin variable $variable_name from subroutine $subroutine_name,\ncroaking" );
89 6         45 die( "\nERROR ENV01, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\nnumber value expected but non-number value found,\nin variable $variable_name from subroutine $subroutine_name,\ndying\n" );
90             }
91 68         124 return;
92             }
93              
94             # [[[ BOOLEANIFY ]]]
95             sub number_to_boolean {
96 0     0   0 { my boolean $RETURN_TYPE };
  0         0  
97 0         0 (my number $input_number) = @ARG;
98             # number_CHECK($input_number);
99 0         0 number_CHECKTRACE( $input_number, '$input_number', 'number_to_boolean()' );
100 0 0       0 if ($input_number == 0) { return 0; }
  0         0  
101 0         0 else { return 1; }
102 0         0 return;
103             }
104              
105             # [[[ UNSIGNED INTEGERIFY ]]]
106             sub number_to_unsigned_integer {
107 0     0   0 { my unsigned_integer $RETURN_TYPE };
  0         0  
108 0         0 (my number $input_number) = @ARG;
109             # number_CHECK($input_number);
110 0         0 number_CHECKTRACE( $input_number, '$input_number', 'number_to_unsigned_integer()' );
111 0         0 return floor abs $input_number;
112             }
113              
114             # [[[ INTEGERIFY ]]]
115             sub number_to_integer {
116 0     0   0 { my integer $RETURN_TYPE };
  0         0  
117 0         0 (my number $input_number) = @ARG;
118             # number_CHECK($input_number);
119 0         0 number_CHECKTRACE( $input_number, '$input_number', 'number_to_integer()' );
120 0         0 return floor $input_number;
121             }
122              
123             # [[[ CHARACTERIFY ]]]
124             sub number_to_character {
125 0     0   0 { my character $RETURN_TYPE };
  0         0  
126 0         0 (my number $input_number) = @ARG;
127             # number_CHECK($input_number);
128 0         0 number_CHECKTRACE( $input_number, '$input_number', 'number_to_character()' );
129 0         0 my string $tmp_string = number_to_string($input_number);
130 0 0       0 if ($tmp_string eq q{}) { return q{}; }
  0         0  
131 0         0 else { return substr $tmp_string, 0, 1; }
132             }
133              
134             # [[[ STRINGIFY ]]]
135             sub number_to_string {
136 69     69   7348 { my string $RETURN_TYPE };
  69         88  
137 69         84 { my string $RETURN_TYPE };
  69         76  
138 69         102 ( my number $input_number ) = @ARG;
139             # number_CHECK($input_number);
140 69         1300 number_CHECKTRACE( $input_number, '$input_number', 'number_to_string()' );
141              
142             # RPerl::diag("in PERLOPS_PERLTYPES number_to_string(), received \$input_number = $input_number\n");
143             # RPerl::diag("in PERLOPS_PERLTYPES number_to_string()...\n");
144             # die 'TMP DEBUG';
145              
146             # DEV NOTE: disable old stringify w/out underscores
147             # return "$input_number";
148              
149             # NEED FIX: if using RPerl data types here, causes errors for `perl -e 'use RPerl::DataType::Integer;'`
150 64         82 my integer $is_negative = 0;
151             # my $is_negative = 0;
152 64 100       119 if ($input_number < 0) { $is_negative = 1; }
  18         28  
153 64         73 my string $retval;
154             # my $retval;
155 64         331 my $split_parts = [ split /[.]/xms, "$input_number" ]; # string_arrayref
156              
157 64 50       146 if ( exists $split_parts->[0] ) {
158 64         103 $retval = reverse $split_parts->[0];
159 64 100       109 if ($is_negative) { chop $retval; } # remove negative sign
  18         34  
160 64         171 $retval =~ s/(\d{3})/$1_/gxms;
161 64 100       151 if ((substr $retval, -1, 1) eq '_') { chop $retval; }
  10         113  
162 64         101 $retval = reverse $retval;
163             }
164             else {
165 0         0 $retval = '0';
166             }
167              
168 64 100       237 if ( exists $split_parts->[1] ) {
169 41         218 $split_parts->[1] =~ s/(\d{3})/$1_/gxms;
170 41 50       98 if ((substr $split_parts->[1], -1, 1) eq '_') { chop $split_parts->[1]; }
  0         0  
171             # if ((substr $split_parts->[1], 0, 1) eq '_') { chop $split_parts->[1]; } # should not be necessary
172 41         77 $retval .= '.' . $split_parts->[1];
173             }
174              
175 64 100       103 if ($is_negative) { $retval = q{-} . $retval; }
  18         37  
176              
177             # RPerl::diag('in PERLOPS_PERLTYPES number_to_string(), have $retval = ' . q{'} . $retval . q{'} . "\n");
178 64         237 return $retval;
179             }
180              
181             # [[[ TYPE TESTING ]]]
182             sub number__typetest0 {
183 1     1   2 { my number $RETURN_TYPE };
  1         3  
184 1         22 my number $retval
185             = ( 22 / 7 ) + main::RPerl__DataType__Number__MODE_ID(); # return floating-point number value
186              
187             # RPerl::diag("in PERLOPS_PERLTYPES number__typetest0(), have \$retval = $retval\n");
188 1         9 return ($retval);
189             }
190             sub number__typetest1 {
191 9     9   15 { my number $RETURN_TYPE };
  9         16  
192 9         16 ( my number $lucky_number ) = @ARG;
193             # number_CHECK($lucky_number);
194 9         227 number_CHECKTRACE( $lucky_number, '$lucky_number',
195             'number__typetest1()' );
196              
197             # RPerl::diag('in PERLOPS_PERLTYPES number__typetest1(), received $lucky_number = ' . number_to_string($lucky_number) . "\n");
198 4         85 return ( ( $lucky_number * 2 ) + main::RPerl__DataType__Number__MODE_ID() );
199             }
200              
201             1; # end of class