File Coverage

blib/lib/Test/Data/Scalar.pm
Criterion Covered Total %
statement 89 124 71.7
branch 29 52 55.7
condition 15 42 35.7
subroutine 18 23 78.2
pod 18 18 100.0
total 169 259 65.2


line stmt bran cond sub pod time code
1 2     2   29 use 5.008;
  2         5  
2              
3             package Test::Data::Scalar;
4 2     2   10 use strict;
  2         4  
  2         42  
5              
6 2     2   8 use Exporter qw(import);
  2         3  
  2         165  
7              
8             our @EXPORT = qw(
9             blessed_ok defined_ok dualvar_ok greater_than length_ok
10             less_than maxlength_ok minlength_ok number_ok
11             readonly_ok ref_ok ref_type_ok strong_ok tainted_ok
12             untainted_ok weak_ok undef_ok number_between_ok
13             string_between_ok
14             );
15              
16             our $VERSION = '1.244';
17              
18 2     2   11 use Scalar::Util;
  2         4  
  2         80  
19 2     2   10 use Test::Builder;
  2         3  
  2         3151  
20              
21             my $Test = Test::Builder->new();
22              
23             =encoding utf8
24              
25             =head1 NAME
26              
27             Test::Data::Scalar -- test functions for scalar variables
28              
29             =head1 SYNOPSIS
30              
31             use Test::Data qw(Scalar);
32              
33             =head1 DESCRIPTION
34              
35             This modules provides a collection of test utilities for
36             scalar variables. Load the module through Test::Data.
37              
38             =head2 Functions
39              
40             =over 4
41              
42             =item blessed_ok( SCALAR )
43              
44             Ok if the SCALAR is a blessed reference.
45              
46             =cut
47              
48             sub blessed_ok ($;$) {
49 9     9 1 24216 my $ref = ref $_[0];
50 9         36 my $ok = Scalar::Util::blessed($_[0]);
51 9   50     56 my $name = $_[1] || 'Scalar is blessed';
52              
53 9 100       48 $Test->diag("Expected a blessed value, but didn't get it\n\t" .
54             qq|Reference type is "$ref"\n| ) unless $ok;
55              
56 9         1717 $Test->ok( $ok, $name );
57             }
58              
59             =item defined_ok( SCALAR )
60              
61             Ok if the SCALAR is defined.
62              
63             =cut
64              
65             sub defined_ok ($;$) {
66 2     2 1 5176 my $ok = defined $_[0];
67 2   50     11 my $name = $_[1] || 'Scalar is defined';
68              
69 2 100       7 $Test->diag("Expected a defined value, got an undefined one\n", $name )
70             unless $ok;
71              
72 2         243 $Test->ok( $ok, $name );
73             }
74              
75             =item undef_ok( SCALAR )
76              
77             Ok if the SCALAR is undefined.
78              
79             =cut
80              
81             sub undef_ok ($;$) {
82 6   50 6 1 14478 my $name = $_[1] || 'Scalar is undefined';
83              
84 6 50       20 if( @_ > 0 ) {
85 6         10 my $ok = not defined $_[0];
86              
87 6 100       24 $Test->diag("Expected an undefined value, got a defined one\n")
88             unless $ok;
89              
90 6         931 $Test->ok( $ok, $name );
91             }
92             else {
93 0         0 $Test->diag("Expected an undefined value, but got no arguments\n");
94              
95 0         0 $Test->ok( 0, $name );
96             }
97             }
98              
99             =item dualvar_ok( SCALAR )
100              
101             Ok if the scalar is a dualvar.
102              
103             How do I test this?
104              
105             sub dualvar_ok ($;$)
106             {
107             my $ok = Scalar::Util::dualvar( $_[0] );
108             my $name = $_[1] || 'Scalar is a dualvar';
109              
110             $Test->ok( $ok, $name );
111              
112             $Test->diag("Expected a dualvar, didn't get it\n")
113             unless $ok;
114             }
115              
116             =cut
117              
118             =item greater_than( SCALAR, BOUND )
119              
120             Ok if the SCALAR is numerically greater than BOUND.
121              
122             =cut
123              
124             sub greater_than ($$;$) {
125 8     8 1 20744 my $value = shift;
126 8         17 my $bound = shift;
127 8   50     44 my $name = shift || 'Scalar is greater than bound';
128              
129 8         18 my $ok = $value > $bound;
130              
131 8 100       56 $Test->diag("Number is less than the bound.\n\t" .
132             "Expected a number greater than [$bound]\n\t" .
133             "Got [$value]\n") unless $ok;
134              
135 8         1019 $Test->ok( $ok, $name );
136             }
137              
138             =item length_ok( SCALAR, LENGTH )
139              
140             Ok if the length of SCALAR is LENGTH.
141              
142             =cut
143              
144             sub length_ok ($$;$) {
145 19     19 1 57703 my $string = shift;
146 19         41 my $length = shift;
147 19   50     108 my $name = shift || 'Scalar has right length';
148              
149 19         35 my $actual = length $string;
150 19         39 my $ok = $length == $actual;
151              
152 19 100       116 $Test->diag("Length of value not within bounds\n\t" .
153             "Expected length=[$length]\n\t" .
154             "Got [$actual]\n") unless $ok;
155              
156 19         3718 $Test->ok( $ok, $name );
157             }
158              
159             =item less_than( SCALAR, BOUND )
160              
161             Ok if the SCALAR is numerically less than BOUND.
162              
163             =cut
164              
165             sub less_than ($$;$) {
166 8     8 1 20826 my $value = shift;
167 8         16 my $bound = shift;
168 8   50     41 my $name = shift || 'Scalar is less than bound';
169              
170 8         20 my $ok = $value < $bound;
171              
172 8 100       39 $Test->diag("Number is greater than the bound.\n\t" .
173             "Expected a number less than [$bound]\n\t" .
174             "Got [$value]\n") unless $ok;
175              
176 8         958 $Test->ok( $ok, $name );
177             }
178              
179             =item maxlength_ok( SCALAR, LENGTH )
180              
181             Ok is the length of SCALAR is less than or equal to LENGTH.
182              
183             =cut
184              
185             sub maxlength_ok($$;$) {
186 8     8 1 1572 my $string = shift;
187 8         10 my $length = shift;
188 8   50     34 my $name = shift || 'Scalar length is less than bound';
189              
190 8         12 my $actual = length $string;
191 8         13 my $ok = $actual <= $length;
192              
193 8 50       17 $Test->diag("Length of value longer than expected\n\t" .
194             "Expected max=[$length]\n\tGot [$actual]\n") unless $ok;
195              
196 8         19 $Test->ok( $ok, $name );
197             }
198              
199             =item minlength_ok( SCALAR, LENGTH )
200              
201             Ok is the length of SCALAR is greater than or equal to LENGTH.
202              
203             =cut
204              
205             sub minlength_ok($$;$) {
206 12     12 1 2356 my $string = shift;
207 12         15 my $length = shift;
208 12   50     40 my $name = shift || 'Scalar length is greater than bound';
209              
210 12         14 my $actual = length $string;
211 12         17 my $ok = $actual >= $length;
212              
213 12 50       23 $Test->diag("Length of value shorter than expected\n\t" .
214             "Expected min=[$length]\n\tGot [$actual]\n") unless $ok;
215              
216 12         28 $Test->ok( $ok, $name );
217             }
218              
219             =item number_ok( SCALAR )
220              
221             Ok if the SCALAR is a number ( or a string that represents a
222             number ).
223              
224             At the moment, a number is just a string of digits. This needs
225             work.
226              
227             =cut
228              
229             sub number_ok($;$) {
230 0     0 1 0 my $number = shift;
231 0   0     0 my $name = shift || 'Scalar is a number';
232              
233 0 0       0 $number =~ /\D/ ? $Test->ok( 0, $name ) : $Test->ok( 1, $name );
234             }
235              
236             =item number_between_ok( SCALAR, LOWER, UPPER )
237              
238             Ok if the number in SCALAR sorts between the number
239             in LOWER and the number in UPPER, numerically.
240              
241             If you put something that isn't a number into UPPER or
242             LOWER, Perl will try to make it into a number and you
243             may get unexpected results.
244              
245             =cut
246              
247             sub number_between_ok($$$;$) {
248 5     5 1 5483 my $number = shift;
249 5         51 my $lower = shift;
250 5         8 my $upper = shift;
251 5   50     22 my $name = shift || 'Scalar is in numerical range';
252              
253 5 100 33     35 unless( defined $lower and defined $upper ) {
    50          
    50          
254 0         0 $Test->diag("You need to define LOWER and UPPER bounds " .
255             "to use number_between_ok" );
256 0         0 $Test->ok( 0, $name );
257             }
258 0         0 elsif( $upper < $lower ) {
259 0         0 $Test->diag(
260             "Upper bound [$upper] is lower than lower bound [$lower]" );
261 0         0 $Test->ok( 0, $name );
262             }
263 0 100       0 elsif( $number >= $lower and $number <= $upper ) {
264 4         13 $Test->ok( 1, $name );
265             }
266             else {
267 1         9 $Test->diag( "Number [$number] was not within bounds\n",
268             "\tExpected lower bound [$lower]\n",
269             "\tExpected upper bound [$upper]\n" );
270 1         260 $Test->ok( 0, $name );
271             }
272             }
273              
274             =item string_between_ok( SCALAR, LOWER, UPPER )
275              
276             Ok if the string in SCALAR sorts between the string
277             in LOWER and the string in UPPER, ASCII-betically.
278              
279             =cut
280              
281             sub string_between_ok($$$;$) {
282 6     6 1 6551 my $string = shift;
283 6         8 my $lower = shift;
284 6         8 my $upper = shift;
285 6   50     23 my $name = shift || 'Scalar is in string range';
286              
287 6 100 33     61 unless( defined $lower and defined $upper ) {
    50          
    50          
288 0         0 $Test->diag("You need to define LOWER and UPPER bounds " .
289             "to use string_between_ok" );
290 0         0 $Test->ok( 0, $name );
291             }
292 0         0 elsif( $upper lt $lower ) {
293 0         0 $Test->diag(
294             "Upper bound [$upper] is lower than lower bound [$lower]" );
295 0         0 $Test->ok( 0, $name );
296             }
297 0 50       0 elsif( $string ge $lower and $string le $upper ) {
298 5         17 $Test->ok( 1, $name );
299             }
300             else {
301 1         8 $Test->diag( "String [$string] was not within bounds\n",
302             "\tExpected lower bound [$lower]\n",
303             "\tExpected upper bound [$upper]\n" );
304 1         271 $Test->ok( 0, $name );
305             }
306              
307             }
308              
309             =item readonly_ok( SCALAR )
310              
311             Ok is the SCALAR is read-only.
312              
313             =cut
314              
315             sub readonly_ok($;$) {
316 0     0 1 0 my $ok = not Scalar::Util::readonly( $_[0] );
317 0   0     0 my $name = $_[1] || 'Scalar is read-only';
318              
319 0 0       0 $Test->diag("Expected readonly reference, got writeable one\n")
320             unless $ok;
321              
322 0         0 $Test->ok( $ok, $name );
323             }
324              
325             =item ref_ok( SCALAR )
326              
327             Ok if the SCALAR is a reference.
328              
329             =cut
330              
331             sub ref_ok($;$) {
332 2     2 1 3299 my $ok = ref $_[0];
333 2   50     11 my $name = $_[1] || 'Scalar is a reference';
334              
335 2 50       6 $Test->diag("Expected reference, didn't get it\n")
336             unless $ok;
337              
338 2         7 $Test->ok( $ok, $name );
339             }
340              
341             =item ref_type_ok( REF1, REF2 )
342              
343             Ok if REF1 is the same reference type as REF2.
344              
345             =cut
346              
347             sub ref_type_ok($$;$) {
348 0     0 1 0 my $ref1 = ref $_[0];
349 0         0 my $ref2 = ref $_[1];
350 0         0 my $ok = $ref1 eq $ref2;
351 0   0     0 my $name = $_[2] || 'Scalar is right reference type';
352              
353 0 0       0 $Test->diag("Expected references to match\n\tGot $ref1\n\t" .
354             "Expected $ref2\n") unless $ok;
355              
356 0 0       0 ref $_[0] eq ref $_[1] ? $Test->ok( 1, $name ) : $Test->ok( 0, $name );
357             }
358              
359             =item strong_ok( SCALAR )
360              
361             Ok is the SCALAR is not a weak reference.
362              
363             =cut
364              
365             sub strong_ok($;$) {
366 2     2 1 405 my $ok = not Scalar::Util::isweak( $_[0] );
367 2   50     10 my $name = $_[1] || 'Scalar is not a weak reference';
368              
369 2 50       5 $Test->diag("Expected strong reference, got weak one\n")
370             unless $ok;
371              
372 2         5 $Test->ok( $ok, $name );
373             }
374              
375             =item tainted_ok( SCALAR )
376              
377             Ok is the SCALAR is tainted.
378              
379             (Tainted values may seem like a not-Ok thing, but remember, when
380             you use taint checking, you want Perl to taint data, so you
381             should have a test to make sure it happens.)
382              
383             =cut
384              
385             sub tainted_ok($;$) {
386 0     0 1 0 my $ok = Scalar::Util::tainted( $_[0] );
387 0   0     0 my $name = $_[1] || 'Scalar is tainted';
388              
389 0 0       0 $Test->diag("Expected tainted data, got untainted data\n")
390             unless $ok;
391              
392 0         0 $Test->ok( $ok, $name );
393             }
394              
395             =item untainted_ok( SCALAR )
396              
397             Ok if the SCALAR is not tainted.
398              
399             =cut
400              
401             sub untainted_ok($;$) {
402 1     1 1 3199 my $ok = not Scalar::Util::tainted( $_[0] );
403 1   50     8 my $name = $_[1] || 'Scalar is not tainted';
404              
405 1 50       4 $Test->diag("Expected untainted data, got tainted data\n")
406             unless $ok;
407              
408 1         4 $Test->ok( $ok, $name );
409             }
410              
411             =item weak_ok( SCALAR )
412              
413             Ok if the SCALAR is a weak reference.
414              
415             =cut
416              
417             sub weak_ok($;$) {
418 0     0 1   my $ok = Scalar::Util::isweak( $_[0] );
419 0   0       my $name = $_[1] || 'Scalar is a weak reference';
420              
421 0 0         $Test->diag("Expected weak reference, got stronge one\n")
422             unless $ok;
423              
424 0           $Test->ok( $ok, $name );
425             }
426              
427             =back
428              
429             =head1 TO DO
430              
431             * add is_a_filehandle test
432              
433             * add is_vstring test
434              
435             =head1 SEE ALSO
436              
437             L,
438             L,
439             L,
440             L,
441             L,
442             L
443              
444             =head1 SOURCE AVAILABILITY
445              
446             This source is in Github:
447              
448             https://github.com/briandfoy/test-data
449              
450             =head1 AUTHOR
451              
452             brian d foy, C<< >>
453              
454             =head1 COPYRIGHT AND LICENSE
455              
456             Copyright © 2002-2022, brian d foy . All rights reserved.
457              
458             This program is free software; you can redistribute it and/or modify
459             it under the terms of the Artistic License 2.0.
460              
461             =cut
462              
463              
464             "The quick brown fox jumped over the lazy dog";