]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blob - lib/Test/Valgrind/Util.pm
Make sure $version is not set when no suitable valgrind was found
[perl/modules/Test-Valgrind.git] / lib / Test / Valgrind / Util.pm
1 package Test::Valgrind::Util;
2
3 use strict;
4 use warnings;
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<validate_subclass>
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<undef> and the relevant error message.
31
32 =cut
33
34 sub validate_subclass {
35  my ($type) = @_;
36
37  my $base = (caller 0)[0];
38
39  $type =~ s/[^A-Za-z0-9_:]//g;
40  $type =  "${base}::$type" if $type !~ /::/;
41
42  my $stash = do { no strict 'refs'; \%{"${type}::"} };
43  my $ISA   = ($stash && $stash->{ISA}) ? *{$stash->{ISA}}{ARRAY} : undef;
44
45  unless ($ISA and @$ISA >= 1) {
46   local $@;
47   eval "require $type; 1" or return (undef, "Could not load subclass: $@");
48  }
49
50  return (undef, "$type is not a subclass of $base") unless $type->isa($base);
51
52  return $type;
53 }
54
55 =head1 EXPORT
56
57 This module does not export anything.
58
59 =head1 SEE ALSO
60
61 L<Test::Valgrind>.
62
63 =head1 AUTHOR
64
65 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
66
67 You can contact me by mail or on C<irc.perl.org> (vincent).
68
69 =head1 BUGS
70
71 Please report any bugs or feature requests to C<bug-test-valgrind at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Valgrind>.
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