]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blob - lib/Test/Valgrind/Version.pm
Make sure $version is not set when no suitable valgrind was found
[perl/modules/Test-Valgrind.git] / lib / Test / Valgrind / Version.pm
1 package Test::Valgrind::Version;
2
3 use strict;
4 use warnings;
5
6 =head1 NAME
7
8 Test::Valgrind::Version - Object class for valgrind versions.
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 class is used to parse, store and compare C<valgrind> versions.
21
22 =cut
23
24 use base 'Test::Valgrind::Carp';
25
26 use Scalar::Util ();
27
28 my $instanceof = sub {
29  Scalar::Util::blessed($_[0]) && $_[0]->isa($_[1]);
30 };
31
32 =head1 METHODS
33
34 =head2 C<new>
35
36     my $vg_version = Test::Valgrind::Version->new(
37      command_output => qx{valgrind --version},
38     );
39
40     my $vg_version = Test::Valgrind::Version->new(
41      string => '1.2.3',
42     );
43
44 Creates a new L<Test::Valgrind::Version> object representing a C<valgrind> version from one of these two sources :
45
46 =over 4
47
48 =item *
49
50 if the C<command_output> option is specified, then C<new> will try to parse it as the output of C<valgrind --version>.
51
52 =item *
53
54 otherwise the C<string> option must be passed, and its value will be parsed as a 'dotted-integer' version number.
55
56 =back
57
58 An exception is raised if the version number cannot be inferred from the supplied data.
59
60 =cut
61
62 sub new {
63  my ($class, %args) = @_;
64
65  my $output = $args{command_output};
66  my $string;
67  if (defined $output) {
68   ($string) = $output =~ /^valgrind-([0-9]+(?:\.[0-9]+)*)(?!\.)/;
69  } else {
70   $string = $args{string};
71   return $string if $string->$instanceof(__PACKAGE__);
72   if (defined $string and $string =~ /^([0-9]+(?:\.[0-9]+)*)(?!\.)/) {
73    $string = $1;
74   } else {
75    $string = undef;
76   }
77  }
78  $class->_croak('Invalid argument') unless defined $string;
79
80  my @digits = map int, split /\./, $string;
81  my $last   = $#digits;
82  for my $i (reverse 0 .. $#digits) {
83   last if $digits[$i];
84   --$last;
85  }
86
87  bless {
88   _digits => [ @digits[0 .. $last] ],
89   _last   => $last,
90  }, $class;
91 }
92
93 BEGIN {
94  local $@;
95  eval "sub $_ { \$_[0]->{$_} }" for qw<_digits _last>;
96  die $@ if $@;
97 }
98
99 =head1 OVERLOADING
100
101 This class overloads numeric comparison operators (C<< <=> >>, C<< < >>, C<< <= >>, C< == >, C<< => >> and C<< > >>), as well as stringification.
102
103 =cut
104
105 sub _spaceship {
106  my ($left, $right, $swap) = @_;
107
108  unless ($right->$instanceof(__PACKAGE__)) {
109   $right = __PACKAGE__->new(string => $right);
110  }
111  ($right, $left) = ($left, $right) if $swap;
112
113  my $left_digits  = $left->_digits;
114  my $right_digits = $right->_digits;
115
116  my $last_cmp = $left->_last <=> $right->_last;
117  my $last     = ($last_cmp < 0) ? $left->_last : $right->_last;
118
119  for my $i (0 .. $last) {
120   my $cmp = $left_digits->[$i] <=> $right_digits->[$i];
121   return $cmp if $cmp;
122  }
123
124  return $last_cmp;
125 }
126
127 sub _stringify {
128  my $self   = shift;
129  my @digits = @{ $self->_digits };
130  push @digits, 0 until @digits >= 3;
131  join '.', @digits;
132 }
133
134 use overload (
135  '<=>'    => \&_spaceship,
136  '""'     => \&_stringify,
137  fallback => 1,
138 );
139
140 =head1 SEE ALSO
141
142 L<Test::Valgrind>.
143
144 =head1 AUTHOR
145
146 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
147
148 You can contact me by mail or on C<irc.perl.org> (vincent).
149
150 =head1 BUGS
151
152 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>.
153 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
154
155 =head1 SUPPORT
156
157 You can find documentation for this module with the perldoc command.
158
159     perldoc Test::Valgrind::Component
160
161 =head1 COPYRIGHT & LICENSE
162
163 Copyright 2015 Vincent Pit, all rights reserved.
164
165 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
166
167 =cut
168
169 1; # End of Test::Valgrind::Version