1*bf6873c5SCy Schubert#!/usr/bin/perl 2*bf6873c5SCy Schubert# 3*bf6873c5SCy Schubert# Check for errors in valgrind logs. 4*bf6873c5SCy Schubert# 5*bf6873c5SCy Schubert# The canonical version of this file is maintained in the rra-c-util package, 6*bf6873c5SCy Schubert# which can be found at <https://www.eyrie.org/~eagle/software/rra-c-util/>. 7*bf6873c5SCy Schubert# 8*bf6873c5SCy Schubert# Copyright 2018-2019, 2021 Russ Allbery <eagle@eyrie.org> 9*bf6873c5SCy Schubert# 10*bf6873c5SCy Schubert# Permission is hereby granted, free of charge, to any person obtaining a 11*bf6873c5SCy Schubert# copy of this software and associated documentation files (the "Software"), 12*bf6873c5SCy Schubert# to deal in the Software without restriction, including without limitation 13*bf6873c5SCy Schubert# the rights to use, copy, modify, merge, publish, distribute, sublicense, 14*bf6873c5SCy Schubert# and/or sell copies of the Software, and to permit persons to whom the 15*bf6873c5SCy Schubert# Software is furnished to do so, subject to the following conditions: 16*bf6873c5SCy Schubert# 17*bf6873c5SCy Schubert# The above copyright notice and this permission notice shall be included in 18*bf6873c5SCy Schubert# all copies or substantial portions of the Software. 19*bf6873c5SCy Schubert# 20*bf6873c5SCy Schubert# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 21*bf6873c5SCy Schubert# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 22*bf6873c5SCy Schubert# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 23*bf6873c5SCy Schubert# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 24*bf6873c5SCy Schubert# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 25*bf6873c5SCy Schubert# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 26*bf6873c5SCy Schubert# DEALINGS IN THE SOFTWARE. 27*bf6873c5SCy Schubert# 28*bf6873c5SCy Schubert# SPDX-License-Identifier: MIT 29*bf6873c5SCy Schubert 30*bf6873c5SCy Schubertuse 5.010; 31*bf6873c5SCy Schubertuse strict; 32*bf6873c5SCy Schubertuse warnings; 33*bf6873c5SCy Schubert 34*bf6873c5SCy Schubertuse lib "$ENV{C_TAP_SOURCE}/tap/perl"; 35*bf6873c5SCy Schubert 36*bf6873c5SCy Schubertuse Test::RRA; 37*bf6873c5SCy Schubertuse Test::RRA::Automake qw(automake_setup); 38*bf6873c5SCy Schubert 39*bf6873c5SCy Schubertuse File::Spec; 40*bf6873c5SCy Schubertuse Test::More; 41*bf6873c5SCy Schubert 42*bf6873c5SCy Schubert# Skip this test if C_TAP_VALGRIND was not set. 43*bf6873c5SCy Schubertif (!exists $ENV{C_TAP_VALGRIND}) { 44*bf6873c5SCy Schubert plan skip_all => 'Not testing under valgrind'; 45*bf6873c5SCy Schubert} 46*bf6873c5SCy Schubert 47*bf6873c5SCy Schubert# Set up Automake testing. 48*bf6873c5SCy Schubertautomake_setup({ chdir_build => 1 }); 49*bf6873c5SCy Schubert 50*bf6873c5SCy Schubert# Gather the list of valgrind logs (and skip this test if there are none). 51*bf6873c5SCy Schubertopendir(my $logdir, File::Spec->catfile('tests', 'tmp', 'valgrind')) 52*bf6873c5SCy Schubert or plan skip_all => 'No valgrind logs in tests/tmp/valgrind'; 53*bf6873c5SCy Schubertmy @logs = grep { m{ \A log [.] }xms } readdir $logdir; 54*bf6873c5SCy Schubertclosedir($logdir) or BAIL_OUT("cannot close directory: $!"); 55*bf6873c5SCy Schubert 56*bf6873c5SCy Schubert# Check each log file. 57*bf6873c5SCy Schubertplan tests => scalar(@logs); 58*bf6873c5SCy Schubertfor my $file (@logs) { 59*bf6873c5SCy Schubert my $path = File::Spec->catfile('tests', 'tmp', 'valgrind', $file); 60*bf6873c5SCy Schubert open(my $log, '<', $path) or BAIL_OUT("cannot open $path: $!"); 61*bf6873c5SCy Schubert my $okay = 1; 62*bf6873c5SCy Schubert my @log; 63*bf6873c5SCy Schubert while (defined(my $line = <$log>)) { 64*bf6873c5SCy Schubert push(@log, $line); 65*bf6873c5SCy Schubert if ($line =~ m{ ERROR [ ] SUMMARY: [ ] (\d+) [ ] errors }xms) { 66*bf6873c5SCy Schubert $okay = ($1 == 0); 67*bf6873c5SCy Schubert } 68*bf6873c5SCy Schubert } 69*bf6873c5SCy Schubert close($log) or BAIL_OUT("cannot close $path: $!"); 70*bf6873c5SCy Schubert if ($okay) { 71*bf6873c5SCy Schubert unlink($path); 72*bf6873c5SCy Schubert } else { 73*bf6873c5SCy Schubert for my $line (@log) { 74*bf6873c5SCy Schubert print '# ', $line 75*bf6873c5SCy Schubert or BAIL_OUT("cannot print to standard output: $!"); 76*bf6873c5SCy Schubert } 77*bf6873c5SCy Schubert } 78*bf6873c5SCy Schubert ok($okay, $path); 79*bf6873c5SCy Schubert} 80*bf6873c5SCy Schubert 81*bf6873c5SCy Schubert# Remove tests/tmp/valgrind if it's now empty. 82*bf6873c5SCy Schubertrmdir(File::Spec->catfile('tests', 'tmp', 'valgrind')); 83*bf6873c5SCy Schubertrmdir(File::Spec->catfile('tests', 'tmp')); 84