File Coverage

blib/lib/Test/Valgrind/Util.pm
Criterion Covered Total %
statement 22 23 95.6
branch 5 10 50.0
condition 2 6 33.3
subroutine 4 4 100.0
pod 1 1 100.0
total 34 44 77.2


line stmt bran cond sub pod time code
1             package Test::Valgrind::Util;
2              
3 7     7   34 use strict;
  7         11  
  7         170  
4 7     7   36 use warnings;
  7         51  
  7         922  
5              
6             =head1 NAME
7              
8             Test::Valgrind::Util - Utility routines for Test::Valgrind.
9              
10             =head1 VERSION
11              
12             Version 1.17
13              
14             =cut
15              
16             our $VERSION = '1.17';
17              
18             =head1 DESCRIPTION
19              
20             This module contains some helpers used by Test::Valgrind.
21             It is not really designed to be used anywhere else.
22              
23             =head1 FUNCTIONS
24              
25             =head2 C
26              
27             my ($validated_type, $error_msg) = validate_subclass($type);
28              
29             Try to interpret C<$type> as a subclass of the caller package, and load it if its C<@ISA> is empty.
30             Returns the validated type, or C and the relevant error message.
31              
32             =cut
33              
34             sub validate_subclass {
35 7     7 1 14 my ($type) = @_;
36              
37 7         62 my $base = (caller 0)[0];
38              
39 7         33 $type =~ s/[^A-Za-z0-9_:]//g;
40 7 50       43 $type = "${base}::$type" if $type !~ /::/;
41              
42 7     7   36 my $stash = do { no strict 'refs'; \%{"${type}::"} };
  7         14  
  7         1293  
  7         15  
  7         13  
  7         54  
43 7 50 33     58 my $ISA = ($stash && $stash->{ISA}) ? *{$stash->{ISA}}{ARRAY} : undef;
  0         0  
44              
45 7 50 33     32 unless ($ISA and @$ISA >= 1) {
46 7         14 local $@;
47 7 50       468 eval "require $type; 1" or return (undef, "Could not load subclass: $@");
48             }
49              
50 7 50       103 return (undef, "$type is not a subclass of $base") unless $type->isa($base);
51              
52 7         41 return $type;
53             }
54              
55             =head1 EXPORT
56              
57             This module does not export anything.
58              
59             =head1 SEE ALSO
60              
61             L.
62              
63             =head1 AUTHOR
64              
65             Vincent Pit, C<< >>, L.
66              
67             You can contact me by mail or on C (vincent).
68              
69             =head1 BUGS
70              
71             Please report any bugs or feature requests to C, or through the web interface at L.
72             I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
73              
74             =head1 SUPPORT
75              
76             You can find documentation for this module with the perldoc command.
77              
78             perldoc Test::Valgrind::Component
79              
80             =head1 COPYRIGHT & LICENSE
81              
82             Copyright 2015 Vincent Pit, all rights reserved.
83              
84             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
85              
86             =cut
87              
88             1; # End of Test::Valgrind::Util