|
1 | 1 | #!/usr/bin/perl
|
2 | 2 |
|
| 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 | + |
3 | 16 | use strict;
|
4 | 17 | use warnings;
|
5 |
| -use Test::More tests => 154; |
6 | 18 | use File::Which qw(which);
|
| 19 | +use Term::ANSIColor; |
| 20 | +use Test::More tests => 205; |
7 | 21 |
|
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"); |
9 | 27 |
|
| 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 )); |
10 | 36 |
|
11 | 37 | ## 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"); |
33 | 45 | };
|
34 | 46 |
|
| 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 | +}; |
35 | 53 |
|
36 | 54 | ## see baddata/BadFile.txt for explanations of return values
|
37 | 55 | my %return = ('00' => 0, '01' => 1, '02' => 0, '03' => 0, '04' => 0, '05' => 0,
|
|
42 | 60 | '30' => 0, '31' => 0, '32' => 0, '33' => 0, '34' => 0, '35' => 0);
|
43 | 61 |
|
44 | 62 | ## bad data
|
| 63 | +message('leaks', 'bad'); |
45 | 64 | 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"); |
52 | 89 | };
|
53 | 90 |
|
54 | 91 |
|
|
0 commit comments