1#!/usr/bin/env perl 2# SPDX-License-Identifier: BSD-3-Clause 3 4# 5# match -- compare an output file with expected results 6# 7# usage: match [-adoqv] [match-file]... 8# 9# this script compares the output from a test run, stored in a file, with 10# the expected output. comparison is done line-by-line until either all 11# lines compare correctly (exit code 0) or a miscompare is found (exit 12# code nonzero). 13# 14# expected output is stored in a ".match" file, which contains a copy of 15# the expected output with embedded tokens for things that should not be 16# exact matches. the supported tokens are: 17# 18# $(N) an integer (i.e. one or more decimal digits) 19# $(NC) one or more decimal digits with comma separators 20# $(FP) a floating point number 21# $(S) ascii string 22# $(X) hex number 23# $(XX) hex number prefixed with 0x 24# $(W) whitespace 25# $(nW) non-whitespace 26# $(*) any string 27# $(DD) output of a "dd" run 28# $(OPT) line is optional (may be missing, matched if found) 29# $(OPX) ends a contiguous list of $(OPT)...$(OPX) lines, at least 30# one of which must match 31# $(UUID) universally unique identifier 32# 33# Additionally, if any "X.ignore" file exists, strings or phrases found per 34# line in the file will be ignored if found as a substring in the 35# corresponding output file (making it easy to skip entire output lines). 36# 37# arguments are: 38# 39# -a find all files of the form "X.match" in the current 40# directory and match them again the corresponding file "X". 41# 42# -o custom output filename - only one match file can be given 43# 44# -d debug -- show lots of debug output 45# 46# -q don't print log files on mismatch 47# 48# -v verbose -- show every line as it is being matched 49# 50 51use strict; 52use Getopt::Std; 53use Encode; 54use v5.16; 55 56select STDERR; 57binmode(STDOUT, ":utf8"); 58binmode(STDERR, ":utf8"); 59 60my $Me = $0; 61$Me =~ s,.*/,,; 62 63our ($opt_a, $opt_d, $opt_q, $opt_v, $opt_o); 64 65$SIG{HUP} = $SIG{INT} = $SIG{TERM} = $SIG{__DIE__} = sub { 66 die @_ if $^S; 67 my $errstr = shift; 68 die "FAIL: $Me: $errstr"; 69}; 70 71sub usage { 72 my $msg = shift; 73 74 warn "$Me: $msg\n" if $msg; 75 warn "Usage: $Me [-adqv] [match-file]...\n"; 76 warn " or: $Me [-dqv] -o output-file match-file...\n"; 77 exit 1; 78} 79 80getopts('adoqv') or usage; 81 82my %match2file; 83 84if ($opt_a) { 85 usage("-a and filename arguments are mutually exclusive") 86 if $#ARGV != -1; 87 opendir(DIR, '.') or die "opendir: .: $!\n"; 88 my @matchfiles = grep { /(.*)\.match$/ && -f $1 } readdir(DIR); 89 closedir(DIR); 90 die "no files found to process\n" unless @matchfiles; 91 foreach my $mfile (@matchfiles) { 92 die "$mfile: $!\n" unless open(F, $mfile); 93 close(F); 94 my $ofile = $mfile; 95 $ofile =~ s/\.match$//; 96 die "$mfile found but cannot open $ofile: $!\n" 97 unless open(F, $ofile); 98 close(F); 99 $match2file{$mfile} = $ofile; 100 } 101} elsif ($opt_o) { 102 usage("-o argument requires two paths") if $#ARGV != 1; 103 104 $match2file{$ARGV[1]} = $ARGV[0]; 105} else { 106 usage("no match-file arguments found") if $#ARGV == -1; 107 108 # to improve the failure case, check all filename args exist and 109 # are provided in pairs now, before going through and processing them 110 foreach my $mfile (@ARGV) { 111 my $ofile = $mfile; 112 usage("$mfile: not a .match file") unless 113 $ofile =~ s/\.match$//; 114 usage("$mfile: $!") unless open(F, $mfile); 115 close(F); 116 usage("$ofile: $!") unless open(F, $ofile); 117 close(F); 118 $match2file{$mfile} = $ofile; 119 } 120} 121 122my $mfile; 123my $ofile; 124my $ifile; 125print "Files to be processed:\n" if $opt_v; 126foreach $mfile (sort keys %match2file) { 127 $ofile = $match2file{$mfile}; 128 $ifile = $ofile . ".ignore"; 129 $ifile = undef unless (-f $ifile); 130 if ($opt_v) { 131 print " match-file \"$mfile\" output-file \"$ofile\""; 132 if ($ifile) { 133 print " ignore-file $ifile\n"; 134 } else { 135 print "\n"; 136 } 137 } 138 match($mfile, $ofile, $ifile); 139} 140 141exit 0; 142 143# 144# strip_it - user can optionally ignore lines from files that contain 145# any number of substrings listed in a file called "X.ignore" where X 146# is the name of the output file. 147# 148sub strip_it { 149 my ($ifile, $file, $input) = @_; 150 # if there is no ignore file just return unaltered input 151 return $input unless $ifile; 152 my @lines_in = split /^/, $input; 153 my $output; 154 my $line_in; 155 my @i_file = split /^/, snarf($ifile); 156 my $i_line; 157 my $ignore_it = 0; 158 159 foreach $line_in (@lines_in) { 160 my @i_lines = @i_file; 161 foreach $i_line (@i_lines) { 162 # Check if both ignore and input lines are new lines 163 if ($i_line eq "\n" && $line_in eq "\n") { 164 $ignore_it = 1; 165 last; 166 } 167 # Find the ignore string in input line 168 chomp($i_line); 169 if (index($line_in, $i_line) != -1 && length($i_line) != 0) { 170 $ignore_it = 1; 171 last; 172 } 173 } 174 if ($ignore_it == 0) { 175 $output .= $line_in; 176 } elsif($opt_v) { 177 print "Ignoring (from $file): $line_in"; 178 } 179 $ignore_it = 0; 180 } 181 return $output; 182} 183 184# 185# match -- process a match-file, output-file pair 186# 187sub match { 188 my ($mfile, $ofile, $ifile) = @_; 189 my $pat; 190 my $output = snarf($ofile); 191 $output = strip_it($ifile, $ofile, $output); 192 my $all_lines = $output; 193 my $line_pat = 0; 194 my $line_out = 0; 195 my $opt = 0; 196 my $opx = 0; 197 my $opt_found = 0; 198 my $fstr = snarf($mfile); 199 $fstr = strip_it($ifile, $mfile, $fstr); 200 for (split /^/, $fstr) { 201 $pat = $_; 202 $line_pat++; 203 $line_out++; 204 s/([*+?|{}.\\^\$\[()])/\\$1/g; 205 s/\\\$\\\(FP\\\)/[-+]?\\d*\\.?\\d+([eE][-+]?\\d+)?/g; 206 s/\\\$\\\(N\\\)/[-+]?\\d+/g; 207 s/\\\$\\\(NC\\\)/[-+]?\\d+(,[0-9]+)*/g; 208 s/\\\$\\\(\\\*\\\)/\\p{Print}*/g; 209 s/\\\$\\\(S\\\)/\\P{IsC}+/g; 210 s/\\\$\\\(X\\\)/\\p{XPosixXDigit}+/g; 211 s/\\\$\\\(XX\\\)/0x\\p{XPosixXDigit}+/g; 212 s/\\\$\\\(W\\\)/\\p{Blank}*/g; 213 s/\\\$\\\(nW\\\)/\\p{Graph}*/g; 214 s/\\\$\\\(DD\\\)/\\d+\\+\\d+ records in\n\\d+\\+\\d+ records out\n\\d+ bytes \\\(\\d+ .B\\\) copied, [.0-9e-]+[^,]*, [.0-9]+ .B.s/g; 215 s/\\\$\\\(UUID\\\)/\\p{XPosixXDigit}{8}-\\p{XPosixXDigit}{4}-\\p{XPosixXDigit}{4}-\\p{XPosixXDigit}{4}-\\p{XPosixXDigit}{12}/g; 216 if (s/\\\$\\\(OPT\\\)//) { 217 $opt = 1; 218 } elsif (s/\\\$\\\(OPX\\\)//) { 219 $opx = 1; 220 } else { 221 $opt_found = 0; 222 } 223 224 if ($opt_v) { 225 my @lines = split /\n/, $output; 226 my $line; 227 if (@lines) { 228 $line = $lines[0]; 229 } else { 230 $line = "[EOF]"; 231 } 232 233 printf("%s:%-3d %s%s:%-3d %s\n", $mfile, $line_pat, $pat, $ofile, $line_out, $line); 234 } 235 236 print " => /$_/\n" if $opt_d; 237 print " [$output]\n" if $opt_d; 238 unless ($output =~ s/^$_//) { 239 if ($opt || ($opx && $opt_found)) { 240 printf("%s:%-3d [skipping optional line]\n", $ofile, $line_out) if $opt_v; 241 $line_out--; 242 $opt = 0; 243 } else { 244 if (!$opt_v) { 245 if ($opt_q) { 246 print "[MATCHING FAILED]\n"; 247 } else { 248 print "[MATCHING FAILED, COMPLETE FILE ($ofile) BELOW]\n$all_lines\n[EOF]\n"; 249 } 250 $opt_v = 1; 251 match($mfile, $ofile); 252 } 253 254 die "$mfile:$line_pat did not match pattern\n"; 255 } 256 } elsif ($opt) { 257 $opt_found = 1; 258 } 259 $opx = 0; 260 } 261 262 if ($output ne '') { 263 if (!$opt_v) { 264 if ($opt_q) { 265 print "[MATCHING FAILED]\n"; 266 } else { 267 print "[MATCHING FAILED, COMPLETE FILE ($ofile) BELOW]\n$all_lines\n[EOF]\n"; 268 } 269 } 270 271 # make it a little more print-friendly... 272 $output =~ s/\n/\\n/g; 273 die "line $line_pat: unexpected output: \"$output\"\n"; 274 } 275} 276 277 278# 279# snarf -- slurp an entire file into memory 280# 281sub snarf { 282 my ($file) = @_; 283 my $fh; 284 open($fh, '<', $file) or die "$file $!\n"; 285 286 local $/; 287 $_ = <$fh>; 288 close $fh; 289 290 # check known encodings or die 291 my $decoded; 292 my @encodings = ("UTF-8", "UTF-16", "UTF-16LE", "UTF-16BE"); 293 294 foreach my $enc (@encodings) { 295 eval { $decoded = decode( $enc, $_, Encode::FB_CROAK ) }; 296 297 if (!$@) { 298 $decoded =~ s/\R/\n/g; 299 return $decoded; 300 } 301 } 302 303 die "$Me: ERROR: Unknown file encoding"; 304} 305