Skip to content

Commit f9061b7

Browse files
committed
Improve test script following #55 (comment)
1 parent afab545 commit f9061b7

File tree

1 file changed

+66
-29
lines changed

1 file changed

+66
-29
lines changed

lib/test_valgrind.pl

Lines changed: 66 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -1,37 +1,55 @@
11
#!/usr/bin/perl
22

3+
BEGIN {
4+
eval "use File::Which;";
5+
if ($@) {
6+
print "
7+
This test script requires the perl module File::Which.
8+
See https://metacpan.org/pod/File::Which or
9+
install from the command line with 'cpanp i File::Which'
10+
11+
";
12+
exit;
13+
};
14+
};
15+
316
use strict;
417
use warnings;
5-
use Test::More tests => 154;
618
use File::Which qw(which);
19+
use Term::ANSIColor;
20+
use Test::More tests => 205;
721

8-
ok(which('valgrind'), "valgrind is in the execution path");
22+
my $found = which('valgrind');
23+
if (not defined($found)) {
24+
die "\nValgrind is required for these tests, but seems not to be installed on your computer.\n\n";
25+
};
26+
ok($found, "valgrind is in the execution path");
927

28+
my ($valgrind, $command, $x, $n);
29+
my %valgrind = (leaks => "valgrind --track-origins=yes --leak-check=full --show-leak-kinds=all",
30+
bounds => "valgrind --tool=exp-sgcheck", );
31+
my @good_data = (qw(co_metal_rt.xdi cu_metal_10K.xdi cu_metal_rt.xdi
32+
fe2o3_rt.xdi fe3c_rt.xdi fe_metal_rt.xdi
33+
fen_rt.xdi feo_rt1.xdi ni_metal_rt.xdi
34+
nonxafs_1d.xdi nonxafs_2d.xdi pt_metal_rt.xdi
35+
se_na2so4_rt.xdi se_znse_rt.xdi zn_znse_rt.xdi ));
1036

1137
## good data
12-
foreach my $file (qw(co_metal_rt.xdi
13-
cu_metal_10K.xdi
14-
cu_metal_rt.xdi
15-
fe2o3_rt.xdi
16-
fe3c_rt.xdi
17-
fe_metal_rt.xdi
18-
fen_rt.xdi
19-
feo_rt1.xdi
20-
ni_metal_rt.xdi
21-
nonxafs_1d.xdi
22-
nonxafs_2d.xdi
23-
pt_metal_rt.xdi
24-
se_na2so4_rt.xdi
25-
se_znse_rt.xdi
26-
zn_znse_rt.xdi
27-
)) {
28-
my $command = "valgrind --track-origins=yes --leak-check=full --show-leak-kinds=all ./xdi_reader ../data/$file 2>&1";
29-
my $x = `$command`;
30-
ok(($x =~ m{All heap blocks were freed}), "blocks: $file");
31-
ok(($x =~ m{0 errors}), "errors: $file");
32-
ok((not $?), "$file return value is 0");
38+
message('leaks', 'good');
39+
foreach my $file (@good_data) {
40+
$command = $valgrind{leaks} . " ./xdi_reader ../data/$file 2>&1";
41+
$x = `$command`;
42+
ok(($x =~ m{All heap blocks were freed}), "all blocks freed: $file");
43+
ok(($x =~ m{0 errors}), "no errors: $file");
44+
ok((not $?), "$file return value is 0");
3345
};
3446

47+
message('bounds', 'good');
48+
foreach my $file (@good_data) {
49+
$command = $valgrind{bounds} . " ./xdi_reader ../data/$file 2>&1";
50+
$x = `$command`;
51+
ok(($x =~ m{0 errors}), "no errors: $file");
52+
};
3553

3654
## see baddata/BadFile.txt for explanations of return values
3755
my %return = ('00' => 0, '01' => 1, '02' => 0, '03' => 0, '04' => 0, '05' => 0,
@@ -42,13 +60,32 @@
4260
'30' => 0, '31' => 0, '32' => 0, '33' => 0, '34' => 0, '35' => 0);
4361

4462
## bad data
63+
message('leaks', 'bad');
4564
foreach my $i (0 .. 35) {
46-
my $n = sprintf("%2.2d", $i);
47-
my $command = "valgrind --track-origins=yes --leak-check=full --show-leak-kinds=all ./xdi_reader ../baddata/bad_$n.xdi 2>&1";
48-
my $x = `$command`;
49-
ok(($x =~ m{All heap blocks were freed}), "blocks: bad_$n.xdi");
50-
ok(($x =~ m{0 errors}), "errors: bad_$n.xdi");
51-
ok((not ($? xor $return{$n})), "bad_$n.xdi return value is $?");
65+
$n = sprintf("%2.2d", $i);
66+
$command = $valgrind{leaks} . " ./xdi_reader ../baddata/bad_$n.xdi 2>&1";
67+
$x = `$command`;
68+
ok(($x =~ m{All heap blocks were freed}), "all blocks freed: bad_$n.xdi");
69+
ok(($x =~ m{0 errors}), "no errors: bad_$n.xdi");
70+
ok((not ($? xor $return{$n})), "bad_$n.xdi return value is $?");
71+
};
72+
73+
message('bounds', 'bad');
74+
foreach my $i (0 .. 35) {
75+
$n = sprintf("%2.2d", $i);
76+
$command = $valgrind{bounds} . " ./xdi_reader ../baddata/bad_$n.xdi 2>&1";
77+
$x = `$command`;
78+
ok(($x =~ m{0 errors}), "no errors: bad_$n.xdi");
79+
};
80+
81+
82+
## write a helpful message about what set of tests is being performed
83+
sub message {
84+
my ($test, $data) = @_;
85+
my %tests = (leaks => 'Testing for memory leaks',
86+
bounds => 'Bounds checking',);
87+
print colored(['green'], "$tests{$test}, $data data.", "\n");
88+
print colored(['yellow'], 'Command is: "', $valgrind{$test}, " ./xdi_reader <file>\"\n");
5289
};
5390

5491

0 commit comments

Comments
 (0)