File Coverage

blib/lib/Test/Type.pm
Criterion Covered Total %
statement 85 85 100.0
branch 55 66 83.3
condition n/a
subroutine 13 13 100.0
pod 7 7 100.0
total 160 171 93.5


line stmt bran cond sub pod time code
1             package Test::Type;
2              
3 8     8   218793 use strict;
  8         14  
  8         220  
4 8     8   29 use warnings;
  8         14  
  8         197  
5              
6 8     8   27 use Carp qw();
  8         13  
  8         94  
7 8     8   1400 use Data::Validate::Type;
  8         22016  
  8         602  
8 8     8   42 use Exporter 'import';
  8         10  
  8         204  
9 8     8   27 use Test::More qw();
  8         11  
  8         6954  
10              
11              
12             =head1 NAME
13              
14             Test::Type - Functions to validate data types in test files.
15              
16              
17             =head1 VERSION
18              
19             Version 1.3.0
20              
21             =cut
22              
23             our $VERSION = '1.3.0';
24              
25              
26             =head1 SYNOPSIS
27              
28             use Test::Type;
29              
30             # Test strings.
31             ok_string( $variable );
32             ok_string(
33             $variable,
34             name => 'My variable',
35             );
36              
37             # Test arrayrefs.
38             ok_arrayref( $variable );
39             ok_arrayref(
40             $variable,
41             name => 'My variable',
42             );
43              
44             # Test hashrefs.
45             ok_hashref( $variable );
46             ok_hashref(
47             $variable,
48             name => 'Test variable',
49             );
50              
51             # Test coderefs.
52             ok_coderef( $variable );
53             ok_coderef(
54             $variable,
55             name => 'Test variable',
56             );
57              
58             # Test numbers.
59             ok_number( $variable );
60             ok_number(
61             $variable,
62             name => 'Test variable',
63             );
64              
65             # Test instances.
66             ok_instance(
67             $variable,
68             class => $class,
69             );
70             ok_instance(
71             $variable,
72             name => 'Test variable',
73             class => $class,
74             );
75              
76             # Test regular expressions.
77             ok_regex( $variable );
78             ok_regex(
79             $variable,
80             name => 'Test regular expression',
81             );
82              
83             =cut
84              
85             our @EXPORT = ## no critic (Modules::ProhibitAutomaticExportation)
86             (
87             'ok_arrayref',
88             'ok_coderef',
89             'ok_hashref',
90             'ok_instance',
91             'ok_number',
92             'ok_string',
93             'ok_regex',
94             );
95              
96              
97             =head1 FUNCTIONS
98              
99             =head2 ok_string()
100              
101             Test if the variable passed is a string.
102              
103             ok_string(
104             $variable,
105             );
106              
107             ok_string(
108             $variable,
109             name => 'My variable',
110             );
111              
112             ok_string(
113             $variable,
114             name => 'My variable',
115             allow_empty => 1,
116             );
117              
118             Parameters:
119              
120             =over 4
121              
122             =item * name
123              
124             Optional, the name of the variable being tested.
125              
126             =item * allow_empty
127              
128             Boolean, default 1. Allow the string to be empty or not.
129              
130             =back
131              
132             =cut
133              
134             sub ok_string
135             {
136 5     5 1 3624 my ( $variable, %args ) = @_;
137              
138             # Verify arguments and set defaults.
139 5         9 my $name = delete( $args{'name'} );
140 5 100       13 $name = 'Variable' if !defined( $name );
141 5         6 my $allow_empty = delete( $args{'allow_empty'} );
142 5 100       11 $allow_empty = 1 if !defined( $allow_empty );
143 5 50       11 Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
144             if scalar( keys %args ) != 0;
145              
146 5         6 my @test_properties = ();
147 5 100       12 push( @test_properties, $allow_empty ? 'allow empty' : 'non-empty' );
148 5 50       13 my $test_properties = scalar( @test_properties ) == 0
149             ? ''
150             : ' (' . join( ', ', @test_properties ) . ')';
151              
152 5         14 return Test::More::ok(
153             Data::Validate::Type::is_string(
154             $variable,
155             allow_empty => $allow_empty,
156             ),
157             $name . ' is a string' . $test_properties . '.',
158             );
159             }
160              
161              
162             =head2 ok_arrayref()
163              
164             Test if the variable passed is an arrayref that can be dereferenced into an
165             array.
166              
167             ok_arrayref( $variable );
168              
169             ok_arrayref(
170             $variable,
171             name => 'My variable',
172             );
173              
174             ok_arrayref(
175             $variable,
176             allow_empty => 1,
177             no_blessing => 0,
178             );
179              
180             # Check if the variable is an arrayref of hashrefs.
181             ok_arrayref(
182             $variable,
183             allow_empty => 1,
184             no_blessing => 0,
185             element_validate_type =>
186             sub
187             {
188             return Data::Validate::Type::is_hashref( $_[0] );
189             },
190             );
191              
192             Parameters:
193              
194             =over 4
195              
196             =item * name
197              
198             Optional, the name of the variable being tested.
199              
200             =item * allow_empty
201              
202             Boolean, default 1. Allow the array to be empty or not.
203              
204             =item * no_blessing
205              
206             Boolean, default 0. Require that the variable is not blessed.
207              
208             =item * element_validate_type
209              
210             None by default. Set it to a coderef to validate the elements in the array.
211             The coderef will be passed the element to validate as first parameter, and it
212             must return a boolean indicating whether the element was valid or not.
213              
214             =back
215              
216             =cut
217              
218             sub ok_arrayref
219             {
220 8     8 1 6493 my ( $variable, %args ) = @_;
221              
222             # Verify arguments and set defaults.
223 8         14 my $name = delete( $args{'name'} );
224 8 100       21 $name = 'Variable' if !defined( $name );
225 8         14 my $allow_empty = delete( $args{'allow_empty'} );
226 8 100       17 $allow_empty = 1 if !defined( $allow_empty );
227 8         9 my $no_blessing = delete( $args{'no_blessing'} );
228 8 100       19 $no_blessing = 0 if !defined( $no_blessing );
229 8         9 my $element_validate_type = delete( $args{'element_validate_type'} );
230 8 50       21 Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
231             if scalar( keys %args ) != 0;
232              
233 8         9 my @test_properties = ();
234 8 100       17 push( @test_properties, $allow_empty ? 'allow empty' : 'non-empty' );
235 8 100       15 push( @test_properties, $no_blessing ? 'no blessing' : 'allow blessed' );
236 8 100       14 push( @test_properties, 'validate elements' )
237             if $element_validate_type;
238 8 50       27 my $test_properties = scalar( @test_properties ) == 0
239             ? ''
240             : ' (' . join( ', ', @test_properties ) . ')';
241              
242 8         23 return Test::More::ok(
243             Data::Validate::Type::is_arrayref(
244             $variable,
245             allow_empty => $allow_empty,
246             no_blessing => $no_blessing,
247             element_validate_type => $element_validate_type,
248             ),
249             $name . ' is an arrayref' . $test_properties . '.',
250             );
251             }
252              
253              
254             =head2 ok_hashref()
255              
256             Test if the variable passed is a hashref that can be dereferenced into a hash.
257              
258             ok_hashref( $variable );
259              
260             ok_hashref(
261             $variable,
262             name => 'Test variable',
263             );
264              
265             ok_hashref(
266             $variable,
267             allow_empty => 1,
268             no_blessing => 0,
269             );
270              
271             Parameters:
272              
273             =over 4
274              
275             =item * name
276              
277             Optional, the name of the variable being tested.
278              
279             =item * allow_empty
280              
281             Boolean, default 1. Allow the array to be empty or not.
282              
283             =item * no_blessing
284              
285             Boolean, default 0. Require that the variable is not blessed.
286              
287             =back
288              
289             =cut
290              
291             sub ok_hashref
292             {
293 7     7 1 7325 my ( $variable, %args ) = @_;
294              
295             # Verify arguments and set defaults.
296 7         13 my $name = delete( $args{'name'} );
297 7 100       24 $name = 'Variable' if !defined( $name );
298 7         9 my $allow_empty = delete( $args{'allow_empty'} );
299 7 100       18 $allow_empty = 1 if !defined( $allow_empty );
300 7         11 my $no_blessing = delete( $args{'no_blessing'} );
301 7 100       18 $no_blessing = 0 if !defined( $no_blessing );
302 7 50       24 Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
303             if scalar( keys %args ) != 0;
304              
305 7         11 my @test_properties = ();
306 7 100       19 push( @test_properties, $allow_empty ? 'allow empty' : 'non-empty' );
307 7 100       16 push( @test_properties, $no_blessing ? 'no blessing' : 'allow blessed' );
308 7 50       30 my $test_properties = scalar( @test_properties ) == 0
309             ? ''
310             : ' (' . join( ', ', @test_properties ) . ')';
311              
312 7         24 return Test::More::ok(
313             Data::Validate::Type::is_hashref(
314             $variable,
315             allow_empty => $allow_empty,
316             no_blessing => $no_blessing,
317             ),
318             $name . ' is a hashref' . $test_properties . '.',
319             );
320             }
321              
322              
323             =head2 ok_coderef()
324              
325             Test if the variable passed is an coderef that can be dereferenced into a block
326             of code.
327              
328             ok_coderef( $variable );
329              
330             ok_coderef(
331             $variable,
332             name => 'Test variable',
333             );
334              
335             Parameters:
336              
337             =over 4
338              
339             =item * name
340              
341             Optional, the name of the variable being tested.
342              
343             =back
344              
345             =cut
346              
347             sub ok_coderef
348             {
349 3     3 1 2308 my ( $variable, %args ) = @_;
350              
351             # Verify arguments and set defaults.
352 3         7 my $name = delete( $args{'name'} );
353 3 100       8 $name = 'Variable' if !defined( $name );
354 3 50       7 Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
355             if scalar( keys %args ) != 0;
356              
357 3         11 return Test::More::ok(
358             Data::Validate::Type::is_coderef(
359             $variable,
360             ),
361             $name . ' is a coderef.',
362             );
363             }
364              
365              
366             =head2 ok_number()
367              
368             Test if the variable passed is a number.
369              
370             ok_number( $variable );
371              
372             ok_number(
373             $variable,
374             name => 'Test variable',
375             );
376              
377             ok_number(
378             $variable,
379             positive => 1,
380             );
381              
382             ok_number(
383             $variable,
384             strictly_positive => 1,
385             );
386              
387             Parameters:
388              
389             =over 4
390              
391             =item * name
392              
393             Optional, the name of the variable being tested.
394              
395             =item * strictly_positive
396              
397             Boolean, default 0. Set to 1 to check for a strictly positive number.
398              
399             =item * positive
400              
401             Boolean, default 0. Set to 1 to check for a positive number.
402              
403             =back
404              
405             =cut
406              
407             sub ok_number
408             {
409 7     7 1 5655 my ( $variable, %args ) = @_;
410              
411             # Verify arguments and set defaults.
412 7         10 my $name = delete( $args{'name'} );
413 7 100       16 $name = 'Variable' if !defined( $name );
414 7         9 my $strictly_positive = delete( $args{'strictly_positive'} );
415 7 100       13 $strictly_positive = 0 if !defined( $strictly_positive );
416 7         8 my $positive = delete( $args{'positive'} );
417 7 100       12 $positive = 0 if !defined( $positive );
418 7 50       15 Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
419             if scalar( keys %args ) != 0;
420              
421 7         8 my @test_properties = ();
422 7 100       10 push( @test_properties, 'strictly positive' )
423             if $strictly_positive;
424 7 100       11 push( @test_properties, 'positive' )
425             if $positive;
426 7 100       18 my $test_properties = scalar( @test_properties ) == 0
427             ? ''
428             : ' (' . join( ', ', @test_properties ) . ')';
429              
430 7         19 return Test::More::ok(
431             Data::Validate::Type::is_number(
432             $variable,
433             strictly_positive => $strictly_positive,
434             positive => $positive,
435             ),
436             $name . ' is a number' . $test_properties . '.',
437             );
438             }
439              
440              
441             =head2 ok_instance()
442              
443             Test if the variable is an instance of the given class.
444              
445             Note that this handles inheritance properly, so it will succeed if the
446             variable is an instance of a subclass of the class given.
447              
448             ok_instance(
449             $variable,
450             class => $class,
451             );
452              
453             ok_instance(
454             $variable,
455             name => 'Test variable',
456             class => $class,
457             );
458              
459             Parameters:
460              
461             =over 4
462              
463             =item * name
464              
465             Optional, the name of the variable being tested.
466              
467             =item * class
468              
469             Required, the name of the class to check the variable against.
470              
471             =back
472              
473             =cut
474              
475             sub ok_instance
476             {
477 3     3 1 2455 my ( $variable, %args ) = @_;
478              
479             # Verify arguments and set defaults.
480 3         7 my $name = delete( $args{'name'} );
481 3 100       9 $name = 'Variable' if !defined( $name );
482 3         5 my $class = delete( $args{'class'} );
483 3 50       10 Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
484             if scalar( keys %args ) != 0;
485              
486 3         11 return Test::More::ok(
487             Data::Validate::Type::is_instance(
488             $variable,
489             class => $class,
490             ),
491             $name . ' is an instance of ' . $class . '.',
492             );
493             }
494              
495              
496             =head2 ok_regex()
497              
498             Test if the variable is a regular expression.
499              
500             ok_regex( $variable );
501              
502             =cut
503              
504             sub ok_regex
505             {
506 3     3 1 3603 my ( $variable, %args ) = @_;
507              
508             # Verify arguments and set defaults.
509 3         7 my $name = delete( $args{'name'} );
510 3 50       12 $name = 'Variable' if !defined( $name );
511 3 50       11 Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
512             if scalar( keys %args ) != 0;
513              
514 3         11 return Test::More::ok(
515             Data::Validate::Type::is_regex( $variable ),
516             $name . ' is a regular expression.',
517             );
518             }
519              
520              
521             =head1 BUGS
522              
523             Please report any bugs or feature requests to C, or through
524             the web interface at L. I will be notified, and then you'll
525             automatically be notified of progress on your bug as I make changes.
526              
527              
528             =head1 SUPPORT
529              
530             You can find documentation for this module with the perldoc command.
531              
532             perldoc Test::Type
533              
534              
535             You can also look for information at:
536              
537             =over
538              
539             =item *
540              
541             GitHub (report bugs there)
542              
543             L
544              
545             =item *
546              
547             AnnoCPAN: Annotated CPAN documentation
548              
549             L
550              
551             =item *
552              
553             CPAN Ratings
554              
555             L
556              
557             =item *
558              
559             Search CPAN
560              
561             L
562              
563             =back
564              
565              
566             =head1 AUTHOR
567              
568             L,
569             C<< >>.
570              
571              
572             =head1 COPYRIGHT & LICENSE
573              
574             Copyright 2012-2017 Guillaume Aubert.
575              
576             This code is free software; you can redistribute it and/or modify it under the
577             same terms as Perl 5 itself.
578              
579             This program is distributed in the hope that it will be useful, but WITHOUT ANY
580             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
581             PARTICULAR PURPOSE. See the LICENSE file for more details.
582              
583             =cut
584              
585             1;