103ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra# $MirOS: src/bin/mksh/check.pl,v 1.27 2011/05/29 02:18:47 tg Exp $ 25155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# $OpenBSD: th,v 1.13 2006/05/18 21:27:23 miod Exp $ 35155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru#- 403ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra# Copyright (c) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2011 55155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# Thorsten Glaser <tg@mirbsd.org> 65155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# 75155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# Provided that these terms and disclaimer and all copyright notices 85155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# are retained or reproduced in an accompanying document, permission 95155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# is granted to deal in this work without restriction, including un- 105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# limited rights to use, publicly perform, distribute, sell, modify, 115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# merge, give away, or sublicence. 125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# 135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# This work is provided "AS IS" and WITHOUT WARRANTY of any kind, to 145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# the utmost extent permitted by applicable law, neither express nor 155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# implied; without malicious intent or gross negligence. In no event 165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# may a licensor, author or contributor be held liable for indirect, 175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# direct, other damage, loss, or other issues arising in any way out 185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# of dealing in the work, even if advised of the possibility of such 195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# damage or existence of a defect, except proven that it results out 205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# of said person's immediate fault when using the work as intended. 215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru#- 225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# Example test: 235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# name: a-test 245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# description: 255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# a test to show how tests are done 265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# arguments: !-x!-f! 275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# stdin: 285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# echo -n * 295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# false 305155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected-stdout: ! 315155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# * 325155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected-stderr: 335155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# + echo -n * 345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# + false 355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected-exit: 1 365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# --- 375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# This runs the test-program (eg, mksh) with the arguments -x and -f, 385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# standard input is a file containing "echo hi*\nfalse\n". The program 395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# is expected to produce "hi*" (no trailing newline) on standard output, 405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# "+ echo hi*\n+false\n" on standard error, and an exit code of 1. 415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# 425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# 435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# Format of test files: 445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# - blank lines and lines starting with # are ignored 455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# - a test file contains a series of tests 465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# - a test is a series of tag:value pairs ended with a "---" line 475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# (leading/trailing spaces are stripped from the first line of value) 485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# - test tags are: 495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# Tag Flag Description 505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# ----- ---- ----------- 515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# name r The name of the test; should be unique 525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# description m What test does 535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# arguments M Arguments to pass to the program; 545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# default is no arguments. 555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# script m Value is written to a file which 565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# is passed as an argument to the program 575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# (after the arguments arguments) 585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# stdin m Value is written to a file which is 595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# used as standard-input for the program; 605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# default is to use /dev/null. 615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# perl-setup m Value is a perl script which is executed 625155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# just before the test is run. Try to 635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# avoid using this... 645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# perl-cleanup m Value is a perl script which is executed 655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# just after the test is run. Try to 665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# avoid using this... 675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# env-setup M Value is a list of NAME=VALUE elements 685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# which are put in the environment before 695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# the test is run. If the =VALUE is 705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# missing, NAME is removed from the 715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# environment. Programs are run with 725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# the following minimal environment: 735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# HOME, LD_LIBRARY_PATH, LOCPATH, 7403ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra# LOGNAME, PATH, SHELL, UNIXMODE, 7503ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra# USER 765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# (values taken from the environment of 775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# the test harness). 785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# ENV is set to /nonexistant. 795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# __progname is set to the -p argument. 805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# __perlname is set to $^X (perlexe). 815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# file-setup mps Used to create files, directories 825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# and symlinks. First word is either 835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# file, dir or symlink; second word is 845155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# permissions; this is followed by a 855155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# quoted word that is the name of the 865155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# file; the end-quote should be followed 875155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# by a newline, then the file data 885155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# (if any). The first word may be 895155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# preceded by a ! to strip the trailing 905155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# newline in a symlink. 915155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# file-result mps Used to verify a file, symlink or 925155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# directory is created correctly. 935155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# The first word is either 945155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# file, dir or symlink; second word is 955155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected permissions; third word 965155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# is user-id; fourth is group-id; 975155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# fifth is "exact" or "pattern" 985155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# indicating whether the file contents 995155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# which follow is to be matched exactly 1005155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# or if it is a regular expression. 1015155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# The fifth argument is the quoted name 1025155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# of the file that should be created. 1035155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# The end-quote should be followed 1045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# by a newline, then the file data 1055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# (if any). The first word may be 1065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# preceded by a ! to strip the trailing 1075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# newline in the file contents. 1085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# The permissions, user and group fields 1095155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# may be * meaning accept any value. 1105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# time-limit Time limit - the program is sent a 1115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# SIGKILL N seconds. Default is no 1125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# limit. 1135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected-fail 'yes' if the test is expected to fail. 1145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected-exit expected exit code. Can be a number, 1155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# or a C expression using the variables 1165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# e, s and w (exit code, termination 1175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# signal, and status code). 1185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected-stdout m What the test should generate on stdout; 1195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# default is to expect no output. 1205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected-stdout-pattern m A perl pattern which matches the 1215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected output. 1225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected-stderr m What the test should generate on stderr; 1235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# default is to expect no output. 1245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected-stderr-pattern m A perl pattern which matches the 1255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# expected standard error. 1265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# category m Specify a comma separated list of 1275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# 'categories' of program that the test 1285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# is to be run for. A category can be 1295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# negated by prefixing the name with a !. 1305155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# The idea is that some tests in a 1315155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# test suite may apply to a particular 1325155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# program version and shouldn't be run 1335155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# on other versions. The category(s) of 1345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# the program being tested can be 1355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# specified on the command line. 1365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# One category os:XXX is predefined 1375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# (XXX is the operating system name, 1385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# eg, linux, dec_osf). 13903ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra# need-ctty 'yes' if the test needs a ctty, run 14003ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra# with -C regress:no-ctty to disable. 1415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# Flag meanings: 1425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# r tag is required (eg, a test must have a name tag). 1435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# m value can be multiple lines. Lines must be prefixed with 1445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# a tab. If the value part of the initial tag:value line is 1455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# - empty: the initial blank line is stripped. 1465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# - a lone !: the last newline in the value is stripped; 1475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# M value can be multiple lines (prefixed by a tab) and consists 1485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# of multiple fields, delimited by a field separator character. 1495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# The value must start and end with the f-s-c. 1505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# p tag takes parameters (used with m). 1515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# s tag can be used several times. 1525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 1535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruuse POSIX qw(EINTR); 1545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruuse Getopt::Std; 1555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruuse Config; 1565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 1575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$os = defined $^O ? $^O : 'unknown'; 1585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 1595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru($prog = $0) =~ s#.*/##; 1605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 1615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$Usage = <<EOF ; 16203ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy CondraUsage: $prog [-Pv] [-C cat] [-e e=v] [-p prog] [-s fn] [-t tmo] name ... 1635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru -C c Specify the comma separated list of categories the program 1645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru belongs to (see category field). 16503ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra -e e=v Set the environment variable e to v for all tests 16603ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra (if no =v is given, the current value is used) 16703ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra Only one -e option can be given at the moment, sadly. 16803ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra -P program (-p) string has multiple words, and the program is in 16903ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra the path (kludge option) 17003ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra -p p Use p as the program to test 1715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru -s s Read tests from file s; if s is a directory, it is recursively 1725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru scaned for test files (which end in .t). 1735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru -t t Use t as default time limit for tests (default is unlimited) 1745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru -v Verbose mode: print reason test failed. 1755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru name specifies the name of the test(s) to run; if none are 1765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru specified, all tests are run. 1775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste QueruEOF 1785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 1795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# See comment above for flag meanings 1805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru%test_fields = ( 1815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'name', 'r', 1825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'description', 'm', 1835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'arguments', 'M', 1845155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'script', 'm', 1855155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'stdin', 'm', 1865155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'perl-setup', 'm', 1875155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'perl-cleanup', 'm', 1885155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'env-setup', 'M', 1895155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'file-setup', 'mps', 1905155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'file-result', 'mps', 1915155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'time-limit', '', 1925155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'expected-fail', '', 1935155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'expected-exit', '', 1945155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'expected-stdout', 'm', 1955155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'expected-stdout-pattern', 'm', 1965155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'expected-stderr', 'm', 1975155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'expected-stderr-pattern', 'm', 1985155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 'category', 'm', 19903ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra 'need-ctty', '', 20003ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra 'need-pass', '', 2015155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru ); 2025155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# Filled in by read_test() 2035155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru%internal_test_fields = ( 2045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru ':full-name', 1, # file:name 2055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru ':long-name', 1, # dir/file:lineno:name 2065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru ); 2075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# Categories of the program under test. Provide the current 2095155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# os by default. 2105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru%categories = ( 2115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "os:$os", '1' 2125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru ); 2135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$temps = "/tmp/rts$$"; 2155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$tempi = "/tmp/rti$$"; 2165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$tempo = "/tmp/rto$$"; 2175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$tempe = "/tmp/rte$$"; 2185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$tempdir = "/tmp/rtd$$"; 2195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$nfailed = 0; 22103ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra$nifailed = 0; 2225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$nxfailed = 0; 2235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$npassed = 0; 2245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$nxpassed = 0; 2255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru%known_tests = (); 2275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 22803ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condraif (!getopts('C:e:Pp:s:t:v')) { 2295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR $Usage; 2305155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru exit 1; 2315155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 2325155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2335155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querudie "$prog: no program specified (use -p)\n" if !defined $opt_p; 2345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querudie "$prog: no test set specified (use -s)\n" if !defined $opt_s; 2355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$test_prog = $opt_p; 2365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$verbose = defined $opt_v && $opt_v; 2375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$test_set = $opt_s; 2385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruif (defined $opt_t) { 2395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru die "$prog: bad -t argument (should be number > 0): $opt_t\n" 2405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if $opt_t !~ /^\d+$/ || $opt_t <= 0; 2415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $default_time_limit = $opt_t; 2425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 2435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$program_kludge = defined $opt_P ? $opt_P : 0; 2445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruif (defined $opt_C) { 2465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru foreach $c (split(',', $opt_C)) { 2475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $c =~ s/\s+//; 2485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru die "$prog: categories can't be negated on the command line\n" 2495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($c =~ /^!/); 2505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $categories{$c} = 1; 2515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 2525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 2535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# Note which tests are to be run. 2555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru%do_test = (); 2565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querugrep($do_test{$_} = 1, @ARGV); 2575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$all_tests = @ARGV == 0; 2585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru# Set up a very minimal environment 2605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru%new_env = (); 2615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruforeach $env (('HOME', 'LD_LIBRARY_PATH', 'LOCPATH', 'LOGNAME', 26203ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra 'PATH', 'SHELL', 'UNIXMODE', 'USER')) { 2635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $new_env{$env} = $ENV{$env} if defined $ENV{$env}; 2645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 2655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$new_env{'ENV'} = '/nonexistant'; 2665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruif (($os eq 'VMS') || ($Config{perlpath} =~ m/$Config{_exe}$/i)) { 2675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $new_env{'__perlname'} = $Config{perlpath}; 2685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} else { 2695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $new_env{'__perlname'} = $Config{perlpath} . $Config{_exe}; 2705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 2715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruif (defined $opt_e) { 2725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # XXX need a way to allow many -e arguments... 2735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($opt_e =~ /^([a-zA-Z_]\w*)(|=(.*))$/) { 2745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $new_env{$1} = $2 eq '' ? $ENV{$1} : $3; 2755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 2765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru die "$0: bad -e argument: $opt_e\n"; 2775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 2785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 2795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru%old_env = %ENV; 2805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querudie "$prog: couldn't make directory $tempdir - $!\n" if !mkdir($tempdir, 0777); 2825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruchop($pwd = `pwd 2>/dev/null`); 2845155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querudie "$prog: couldn't get current working directory\n" if $pwd eq ''; 2855155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querudie "$prog: couldn't cd to $pwd - $!\n" if !chdir($pwd); 2865155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2875155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruif (!$program_kludge) { 2885155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test_prog = "$pwd/$test_prog" if substr($test_prog, 0, 1) ne '/'; 2895155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru die "$prog: $test_prog is not executable - bye\n" 2905155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (! -x $test_prog && $os ne 'os2'); 2915155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 2925155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2935155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru@trap_sigs = ('TERM', 'QUIT', 'INT', 'PIPE', 'HUP'); 2945155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru@SIG{@trap_sigs} = ('cleanup_exit') x @trap_sigs; 2955155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$child_kill_ok = 0; 2965155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$SIG{'ALRM'} = 'catch_sigalrm'; 2975155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 2985155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$| = 1; 2995155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3005155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruif (-d $test_set) { 3015155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $file_prefix_skip = length($test_set) + 1; 3025155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ret = &process_test_dir($test_set); 3035155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} else { 3045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $file_prefix_skip = 0; 3055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ret = &process_test_file($test_set); 3065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 3075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru&cleanup_exit() if !defined $ret; 3085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 30903ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra$tot_failed = $nfailed + $nifailed + $nxfailed; 3105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru$tot_passed = $npassed + $nxpassed; 3115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruif ($tot_failed || $tot_passed) { 3125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print "Total failed: $tot_failed"; 31303ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra print " ($nifailed ignored)" if $nifailed; 3145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print " ($nxfailed unexpected)" if $nxfailed; 31503ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra print " (as expected)" if $nfailed && !$nxfailed && !$nifailed; 3165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print "\nTotal passed: $tot_passed"; 3175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print " ($nxpassed unexpected)" if $nxpassed; 3185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print "\n"; 3195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 3205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru&cleanup_exit('ok'); 3225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 3245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querucleanup_exit 3255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 3265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($sig, $exitcode) = ('', 1); 3275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($_[0] eq 'ok') { 32903ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra unless ($nxfailed) { 33003ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra $exitcode = 0; 33103ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra } else { 33203ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra $exitcode = 1; 33303ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra } 3345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($_[0] ne '') { 3355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $sig = $_[0]; 3365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 3375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru unlink($tempi, $tempo, $tempe, $temps); 3395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru &scrub_dir($tempdir) if defined $tempdir; 3405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru rmdir($tempdir) if defined $tempdir; 3415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($sig) { 3435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $SIG{$sig} = 'DEFAULT'; 3445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru kill $sig, $$; 3455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return; 3465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 3475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru exit $exitcode; 3485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 3495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 3515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querucatch_sigalrm 3525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 3535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $SIG{'ALRM'} = 'catch_sigalrm'; 3545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru kill(9, $child_pid) if $child_kill_ok; 3555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $child_killed = 1; 3565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 3575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 3595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruprocess_test_dir 3605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 3615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($dir) = @_; 3625155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($ret, $file); 3635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local(@todo) = (); 3645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!opendir(DIR, $dir)) { 3665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: can't open directory $dir - $!\n"; 3675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 3685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 3695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru while (defined ($file = readdir(DIR))) { 3705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru push(@todo, $file) if $file =~ /^[^.].*\.t$/; 3715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 3725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru closedir(DIR); 3735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru foreach $file (@todo) { 3755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $file = "$dir/$file"; 3765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (-d $file) { 3775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ret = &process_test_dir($file); 3785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif (-f _) { 3795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ret = &process_test_file($file); 3805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 3815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru last if !defined $ret; 3825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 3835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3845155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return $ret; 3855155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 3865155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3875155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 3885155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruprocess_test_file 3895155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 3905155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($file) = @_; 3915155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($ret); 3925155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 3935155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!open(IN, $file)) { 3945155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: can't open $file - $!\n"; 3955155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 3965155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 3975155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru binmode(IN); 3985155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru while (1) { 3995155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ret = &read_test($file, IN, *test); 4005155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru last if !defined $ret || !$ret; 4015155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru next if !$all_tests && !$do_test{$test{'name'}}; 4025155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru next if !&category_check(*test); 4035155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ret = &run_test(*test); 4045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru last if !defined $ret; 4055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru close(IN); 4075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return $ret; 4095155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 4105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 4125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querurun_test 4135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 4145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local(*test) = @_; 4155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($name) = $test{':full-name'}; 4165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'stdin'}) { 4185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef if !&write_file($tempi, $test{'stdin'}); 4195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ifile = $tempi; 4205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 4215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ifile = '/dev/null'; 4225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'script'}) { 4255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef if !&write_file($temps, $test{'script'}); 4265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef if !&scrub_dir($tempdir); 4295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4305155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!chdir($tempdir)) { 4315155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: couldn't cd to $tempdir - $!\n"; 4325155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 4335155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'file-setup'}) { 4365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($i); 4375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($type, $perm, $rest, $c, $len, $name); 4385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru for ($i = 0; $i < $test{'file-setup'}; $i++) { 4405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $val = $test{"file-setup:$i"}; 4415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # format is: type perm "name" 4435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru ($type, $perm, $rest) = 4445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru split(' ', $val, 3); 4455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $c = substr($rest, 0, 1); 4465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $len = index($rest, $c, 1) - 1; 4475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $name = substr($rest, 1, $len); 4485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $rest = substr($rest, 2 + $len); 4495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $perm = oct($perm) if $perm =~ /^\d+$/; 4505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($type eq 'file') { 4515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef if !&write_file($name, $rest); 4525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!chmod($perm, $name)) { 4535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 4545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$test{':long-name'}: can't chmod $perm $name - $!\n"; 4555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 4565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($type eq 'dir') { 4585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!mkdir($name, $perm)) { 4595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 4605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$test{':long-name'}: can't mkdir $perm $name - $!\n"; 4615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 4625155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($type eq 'symlink') { 4645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($oumask) = umask($perm); 4655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($ret) = symlink($rest, $name); 4665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru umask($oumask); 4675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!$ret) { 4685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 4695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$test{':long-name'}: couldn't create symlink $name - $!\n"; 4705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 4715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'perl-setup'}) { 4775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru eval $test{'perl-setup'}; 4785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($@ ne '') { 4795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: error running perl-setup - $@\n"; 4805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 4815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4845155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $pid = fork; 4855155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!defined $pid) { 4865155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: can't fork - $!\n"; 4875155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 4885155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 4895155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!$pid) { 4905155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru @SIG{@trap_sigs} = ('DEFAULT') x @trap_sigs; 4915155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $SIG{'ALRM'} = 'DEFAULT'; 4925155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'env-setup'}) { 4935155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($var, $val, $i); 4945155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 4955155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru foreach $var (split(substr($test{'env-setup'}, 0, 1), 4965155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test{'env-setup'})) 4975155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru { 4985155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $i = index($var, '='); 4995155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru next if $i == 0 || $var eq ''; 5005155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($i < 0) { 5015155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru delete $new_env{$var}; 5025155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 5035155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $new_env{substr($var, 0, $i)} = substr($var, $i + 1); 5045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!open(STDIN, "< $ifile")) { 5085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: couldn't open $ifile in child - $!\n"; 5095155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru kill('TERM', $$); 5105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru binmode(STDIN); 5125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!open(STDOUT, "> $tempo")) { 5135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: couldn't open $tempo in child - $!\n"; 5145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru kill('TERM', $$); 5155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru binmode(STDOUT); 5175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!open(STDERR, "> $tempe")) { 5185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDOUT "$prog: couldn't open $tempe in child - $!\n"; 5195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru kill('TERM', $$); 5205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru binmode(STDERR); 5225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($program_kludge) { 5235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru @argv = split(' ', $test_prog); 5245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 5255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru @argv = ($test_prog); 5265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'arguments'}) { 5285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru push(@argv, 5295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru split(substr($test{'arguments'}, 0, 1), 5305155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru substr($test{'arguments'}, 1))); 5315155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5325155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru push(@argv, $temps) if defined $test{'script'}; 5335155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 5345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru #XXX realpathise, use which/whence -p, or sth. like that 5355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru #XXX if !$program_kludge, we get by with not doing it for now tho 5365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $new_env{'__progname'} = $argv[0]; 5375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 5385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # The following doesn't work with perl5... Need to do it explicitly - yuck. 5395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru #%ENV = %new_env; 5405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru foreach $k (keys(%ENV)) { 5415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru delete $ENV{$k}; 5425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ENV{$k} = $v while ($k,$v) = each %new_env; 5445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 5455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru exec { $argv[0] } @argv; 5465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: couldn't execute $test_prog - $!\n"; 5475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru kill('TERM', $$); 5485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru exit(95); 5495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $child_pid = $pid; 5515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $child_killed = 0; 5525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $child_kill_ok = 1; 5535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru alarm($test{'time-limit'}) if defined $test{'time-limit'}; 5545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru while (1) { 5555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $xpid = waitpid($pid, 0); 5565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $child_kill_ok = 0; 5575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($xpid < 0) { 5585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru next if $! == EINTR; 5595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: error waiting for child - $!\n"; 5605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 5615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5625155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru last; 5635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $status = $?; 5655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru alarm(0) if defined $test{'time-limit'}; 5665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 5675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $failed = 0; 5685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why = ''; 5695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 5705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($child_killed) { 5715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $failed = 1; 5725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\ttest timed out (limit of $test{'time-limit'} seconds)\n"; 5735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 5755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ret = &eval_exit($test{'long-name'}, $status, $test{'expected-exit'}); 5765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef if !defined $ret; 5775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!$ret) { 5785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($expl); 5795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 5805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $failed = 1; 5815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (($status & 0xff) == 0x7f) { 5825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $expl = "stopped"; 5835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif (($status & 0xff)) { 5845155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $expl = "signal " . ($status & 0x7f); 5855155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 5865155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $expl = "exit-code " . (($status >> 8) & 0xff); 5875155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5885155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= 5895155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "\tunexpected exit status $status ($expl), expected $test{'expected-exit'}\n"; 5905155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5915155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 5925155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $tmp = &check_output($test{'long-name'}, $tempo, 'stdout', 5935155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test{'expected-stdout'}, $test{'expected-stdout-pattern'}); 5945155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef if !defined $tmp; 5955155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($tmp ne '') { 5965155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $failed = 1; 5975155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= $tmp; 5985155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 5995155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 6005155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $tmp = &check_output($test{'long-name'}, $tempe, 'stderr', 6015155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test{'expected-stderr'}, $test{'expected-stderr-pattern'}); 6025155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef if !defined $tmp; 6035155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($tmp ne '') { 6045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $failed = 1; 6055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= $tmp; 6065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 6075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 6085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $tmp = &check_file_result(*test); 6095155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef if !defined $tmp; 6105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($tmp ne '') { 6115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $failed = 1; 6125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= $tmp; 6135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 6145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 6155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'perl-cleanup'}) { 6165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru eval $test{'perl-cleanup'}; 6175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($@ ne '') { 6185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: error running perl-cleanup - $@\n"; 6195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 6205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 6215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 6225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 6235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!chdir($pwd)) { 6245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: couldn't cd to $pwd - $!\n"; 6255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 6265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 6275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 6285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($failed) { 6295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!$test{'expected-fail'}) { 63003ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra if ($test{'need-pass'}) { 63103ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra print "FAIL $name\n"; 63203ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra $nxfailed++; 63303ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra } else { 63403ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra print "FAIL $name (ignored)\n"; 63503ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra $nifailed++; 63603ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra } 6375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 6385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print "fail $name (as expected)\n"; 6395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $nfailed++; 6405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 6415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why = "\tDescription" 6425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru . &wrap_lines($test{'description'}, " (missing)\n") 6435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru . $why; 6445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($test{'expected-fail'}) { 6455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print "PASS $name (unexpectedly)\n"; 6465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $nxpassed++; 6475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 6485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print "pass $name\n"; 6495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $npassed++; 6505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 6515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print $why if $verbose; 6525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return 0; 6535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 6545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 6555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 6565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querucategory_check 6575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 6585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local(*test) = @_; 6595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($c); 6605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 66103ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra return 0 if ($test{'need-ctty'} && defined $categories{'regress:no-ctty'}); 6625155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return 1 if (!defined $test{'category'}); 6635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($ok) = 0; 6645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru foreach $c (split(',', $test{'category'})) { 6655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $c =~ s/\s+//; 6665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($c =~ /^!/) { 6675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $c = $'; 6685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return 0 if (defined $categories{$c}); 6695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ok = 1; 6705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 6715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ok = 1 if (defined $categories{$c}); 6725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 6735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 6745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return $ok; 6755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 6765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 6775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 6785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruscrub_dir 6795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 6805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($dir) = @_; 6815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local(@todo) = (); 6825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($file); 6835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 6845155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!opendir(DIR, $dir)) { 6855155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: couldn't open directory $dir - $!\n"; 6865155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 6875155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 6885155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru while (defined ($file = readdir(DIR))) { 6895155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru push(@todo, $file) if $file ne '.' && $file ne '..'; 6905155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 6915155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru closedir(DIR); 6925155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru foreach $file (@todo) { 6935155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $file = "$dir/$file"; 6945155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (-d $file) { 6955155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef if !&scrub_dir($file); 6965155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!rmdir($file)) { 6975155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: couldn't rmdir $file - $!\n"; 6985155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 6995155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7005155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 7015155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!unlink($file)) { 7025155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: couldn't unlink $file - $!\n"; 7035155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 7045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return 1; 7085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 7095155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 7105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 7115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruwrite_file 7125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 7135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($file, $str) = @_; 7145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 7155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!open(TEMP, "> $file")) { 7165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: can't open $file - $!\n"; 7175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 7185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru binmode(TEMP); 7205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print TEMP $str; 7215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!close(TEMP)) { 7225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog: error writing $file - $!\n"; 7235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 7245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return 1; 7265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 7275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 7285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 7295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querucheck_output 7305155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 7315155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($name, $file, $what, $expect, $expect_pat) = @_; 7325155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($got) = ''; 7335155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($why) = ''; 7345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($ret); 7355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 7365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!open(TEMP, "< $file")) { 7375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$name($what): couldn't open $file after running program - $!\n"; 7385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 7395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru binmode(TEMP); 7415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru while (<TEMP>) { 7425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $got .= $_; 7435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru close(TEMP); 7455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return compare_output($name, $what, $expect, $expect_pat, $got); 7465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 7475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 7485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 7495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querucompare_output 7505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 7515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($name, $what, $expect, $expect_pat, $got) = @_; 7525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($why) = ''; 7535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 7545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $expect_pat) { 7555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $_ = $got; 7565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ret = eval "$expect_pat"; 7575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($@ ne '') { 7585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$name($what): error evaluating $what pattern: $expect_pat - $@\n"; 7595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 7605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!$ret) { 7625155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why = "\tunexpected $what - wanted pattern"; 7635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= &wrap_lines($expect_pat); 7645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\tgot"; 7655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= &wrap_lines($got); 7665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 7685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $expect = '' if !defined $expect; 7695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($got ne $expect) { 7705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\tunexpected $what - " . &first_diff($expect, $got) . "\n"; 7715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\twanted"; 7725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= &wrap_lines($expect); 7735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\tgot"; 7745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= &wrap_lines($got); 7755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return $why; 7785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 7795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 7805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 7815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruwrap_lines 7825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 7835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($str, $empty) = @_; 7845155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($nonl) = substr($str, -1, 1) ne "\n"; 7855155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 7865155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return (defined $empty ? $empty : " nothing\n") if $str eq ''; 7875155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru substr($str, 0, 0) = ":\n"; 7885155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $str =~ s/\n/\n\t\t/g; 7895155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($nonl) { 7905155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $str .= "\n\t[incomplete last line]\n"; 7915155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 7925155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru chop($str); 7935155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru chop($str); 7945155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 7955155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return $str; 7965155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 7975155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 7985155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 7995155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querufirst_diff 8005155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 8015155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($exp, $got) = @_; 8025155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($lineno, $char) = (1, 1); 8035155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($i, $exp_len, $got_len); 8045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($ce, $cg); 8055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 8065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $exp_len = length($exp); 8075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $got_len = length($got); 8085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($exp_len != $got_len) { 8095155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($exp_len < $got_len) { 8105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (substr($got, 0, $exp_len) eq $exp) { 8115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return "got too much output"; 8125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 8135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif (substr($exp, 0, $got_len) eq $got) { 8145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return "got too little output"; 8155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 8165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 8175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru for ($i = 0; $i < $exp_len; $i++) { 8185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ce = substr($exp, $i, 1); 8195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $cg = substr($got, $i, 1); 8205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru last if $ce ne $cg; 8215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $char++; 8225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($ce eq "\n") { 8235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $lineno++; 8245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $char = 1; 8255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 8265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 8275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return "first difference: line $lineno, char $char (wanted '" 8285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru . &format_char($ce) . "', got '" 8295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru . &format_char($cg) . "'"; 8305155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 8315155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 8325155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 8335155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruformat_char 8345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 8355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($ch, $s); 8365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 8375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ch = ord($_[0]); 8385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($ch == 10) { 8395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return '\n'; 8405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($ch == 13) { 8415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return '\r'; 8425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($ch == 8) { 8435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return '\b'; 8445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($ch == 9) { 8455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return '\t'; 8465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($ch > 127) { 8475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ch -= 127; 8485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $s = "M-"; 8495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 8505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $s = ''; 8515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 8525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($ch < 32) { 8535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $s .= '^'; 8545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $ch += ord('@'); 8555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($ch == 127) { 8565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return $s . "^?"; 8575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 8585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return $s . sprintf("%c", $ch); 8595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 8605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 8615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 8625155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querueval_exit 8635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 8645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($name, $status, $expect) = @_; 8655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($expr); 8665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($w, $e, $s) = ($status, ($status >> 8) & 0xff, $status & 0x7f); 8675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 8685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $e = -1000 if $status & 0xff; 8695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $s = -1000 if $s == 0x7f; 8705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!defined $expect) { 8715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $expr = '$w == 0'; 8725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($expect =~ /^(|-)\d+$/) { 8735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $expr = "\$e == $expect"; 8745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 8755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $expr = $expect; 8765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $expr =~ s/\b([wse])\b/\$$1/g; 8775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $expr =~ s/\b(SIG[A-Z0-9]+)\b/&$1/g; 8785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 8795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $w = eval $expr; 8805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($@ ne '') { 8815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: bad expected-exit expression: $expect ($@)\n"; 8825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 8835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 8845155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return $w; 8855155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 8865155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 8875155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 8885155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queruread_test 8895155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 8905155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($file, $in, *test) = @_; 8915155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($field, $val, $flags, $do_chop, $need_redo, $start_lineno); 8925155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local(%cnt, $sfield); 8935155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 8945155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru %test = (); 8955155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru %cnt = (); 8965155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru while (<$in>) { 8975155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru next if /^\s*$/; 8985155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru next if /^ *#/; 8995155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru last if /^\s*---\s*$/; 9005155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $start_lineno = $. if !defined $start_lineno; 9015155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!/^([-\w]+):\s*(|\S|\S.*\S)\s*$/) { 9025155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$file:$.: unrecognised line\n"; 9035155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 9045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru ($field, $val) = ($1, $2); 9065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $sfield = $field; 9075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $flags = $test_fields{$field}; 9085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!defined $flags) { 9095155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$file:$.: unrecognised field \"$field\"\n"; 9105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 9115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($flags =~ /s/) { 9135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($cnt) = $cnt{$field}++; 9145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test{$field} = $cnt{$field}; 9155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $cnt = 0 if $cnt eq ''; 9165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $sfield .= ":$cnt"; 9175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif (defined $test{$field}) { 9185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$file:$.: multiple \"$field\" fields\n"; 9195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 9205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $do_chop = $flags !~ /m/; 9225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $need_redo = 0; 9235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($val eq '' || $val eq '!' || $flags =~ /p/) { 9245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($flags =~ /[Mm]/) { 9255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($flags =~ /p/) { 9265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($val =~ /^!/) { 9275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $do_chop = 1; 9285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $val = $'; 9295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 9305155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $do_chop = 0; 9315155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9325155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($val eq '') { 9335155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 9345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: no parameters given for field \"$field\"\n"; 9355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 9365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 9385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($val eq '!') { 9395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $do_chop = 1; 9405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $val = ''; 9425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru while (<$in>) { 9445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru last if !/^\t/; 9455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $val .= $'; 9465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru chop $val if $do_chop; 9485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $do_chop = 1; 9495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $need_redo = 1; 9505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 9515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # Syntax check on fields that can several instances 9525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # (can give useful line numbers this way) 9535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 9545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($field eq 'file-setup') { 9555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($type, $perm, $rest, $c, $len, $name); 9565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 9575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # format is: type perm "name" 9585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($val !~ /^[ \t]*(\S+)[ \t]+(\S+)[ \t]+([^ \t].*)/) { 9595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 9605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: bad parameter line for file-setup field\n"; 9615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 9625155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru ($type, $perm, $rest) = ($1, $2, $3); 9645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($type !~ /^(file|dir|symlink)$/) { 9655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 9665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: bad file type for file-setup: $type\n"; 9675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 9685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($perm !~ /^\d+$/) { 9705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 9715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: bad permissions for file-setup: $type\n"; 9725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 9735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $c = substr($rest, 0, 1); 9755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (($len = index($rest, $c, 1) - 1) <= 0) { 9765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 9775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: missing end quote for file name in file-setup: $rest\n"; 9785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 9795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $name = substr($rest, 1, $len); 9815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($name =~ /^\// || $name =~ /(^|\/)\.\.(\/|$)/) { 9825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # Note: this is not a security thing - just a sanity 9835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # check - a test can still use symlinks to get at files 9845155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # outside the test directory. 9855155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 9865155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru"$prog:$file:$.: file name in file-setup is absolute or contains ..: $name\n"; 9875155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 9885155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9895155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 9905155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($field eq 'file-result') { 9915155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($type, $perm, $uid, $gid, $matchType, 9925155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $rest, $c, $len, $name); 9935155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 9945155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # format is: type perm uid gid matchType "name" 9955155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($val !~ /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S.*)/) { 9965155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 9975155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: bad parameter line for file-result field\n"; 9985155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 9995155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10005155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru ($type, $perm, $uid, $gid, $matchType, $rest) 10015155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru = ($1, $2, $3, $4, $5, $6); 10025155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($type !~ /^(file|dir|symlink)$/) { 10035155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 10045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: bad file type for file-result: $type\n"; 10055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 10065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($perm !~ /^\d+$/ && $perm ne '*') { 10085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 10095155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: bad permissions for file-result: $perm\n"; 10105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 10115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($uid !~ /^\d+$/ && $uid ne '*') { 10135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 10145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: bad user-id for file-result: $uid\n"; 10155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 10165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($gid !~ /^\d+$/ && $gid ne '*') { 10185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 10195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: bad group-id for file-result: $gid\n"; 10205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 10215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($matchType !~ /^(exact|pattern)$/) { 10235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 10245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: bad match type for file-result: $matchType\n"; 10255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 10265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $c = substr($rest, 0, 1); 10285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (($len = index($rest, $c, 1) - 1) <= 0) { 10295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 10305155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: missing end quote for file name in file-result: $rest\n"; 10315155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 10325155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10335155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $name = substr($rest, 1, $len); 10345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($name =~ /^\// || $name =~ /(^|\/)\.\.(\/|$)/) { 10355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # Note: this is not a security thing - just a sanity 10365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # check - a test can still use symlinks to get at files 10375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # outside the test directory. 10385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 10395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru"$prog:$file:$.: file name in file-result is absolute or contains ..: $name\n"; 10405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 10415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($val eq '') { 10445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 10455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$.: no value given for field \"$field\"\n"; 10465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 10475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $val .= "\n" if !$do_chop; 10505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test{$sfield} = $val; 10515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru redo if $need_redo; 10525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($_ eq '') { 10545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (%test) { 10555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 10565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$start_lineno: end-of-file while reading test\n"; 10575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 10585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return 0; 10605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 10625155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru while (($field, $val) = each %test_fields) { 10635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($val =~ /r/ && !defined $test{$field}) { 10645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 10655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$file:$start_lineno: required field \"$field\" missing\n"; 10665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 10675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 10705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test{':full-name'} = substr($file, $file_prefix_skip) . ":$test{'name'}"; 10715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test{':long-name'} = "$file:$start_lineno:$test{'name'}"; 10725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 10735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # Syntax check on specific fields 10745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'expected-fail'}) { 10755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($test{'expected-fail'} !~ /^(yes|no)$/) { 10765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 10775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$test{':long-name'}: bad value for expected-fail field\n"; 10785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 10795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 10805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test{'expected-fail'} = $1 eq 'yes'; 10815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 10825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test{'expected-fail'} = 0; 10835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 108403ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra if (defined $test{'need-ctty'}) { 108503ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra if ($test{'need-ctty'} !~ /^(yes|no)$/) { 108603ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra print STDERR 108703ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra "$prog:$test{':long-name'}: bad value for need-ctty field\n"; 108803ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra return undef; 108903ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra } 109003ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra $test{'need-ctty'} = $1 eq 'yes'; 109103ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra } else { 109203ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra $test{'need-ctty'} = 0; 109303ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra } 109403ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra if (defined $test{'need-pass'}) { 109503ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra if ($test{'need-pass'} !~ /^(yes|no)$/) { 109603ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra print STDERR 109703ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra "$prog:$test{':long-name'}: bad value for need-pass field\n"; 109803ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra return undef; 109903ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra } 110003ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra $test{'need-pass'} = $1 eq 'yes'; 110103ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra } else { 110203ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra $test{'need-pass'} = 1; 110303ebf06f4e1112a0e9533b93062d169232c4cbfeGeremy Condra } 11045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'arguments'}) { 11055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($firstc) = substr($test{'arguments'}, 0, 1); 11065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (substr($test{'arguments'}, -1, 1) ne $firstc) { 11085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: arguments field doesn't start and end with the same character\n"; 11095155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 11105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'env-setup'}) { 11135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($firstc) = substr($test{'env-setup'}, 0, 1); 11145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (substr($test{'env-setup'}, -1, 1) ne $firstc) { 11165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: env-setup field doesn't start and end with the same character\n"; 11175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 11185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'expected-exit'}) { 11215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($val) = $test{'expected-exit'}; 11225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($val =~ /^(|-)\d+$/) { 11245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($val < 0 || $val > 255) { 11255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: expected-exit value $val not in 0..255\n"; 11265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 11275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($val !~ /^([\s<>+-=*%\/&|!()]|\b[wse]\b|\bSIG[A-Z0-9]+\b)+$/) { 11295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: bad expected-exit expression: $val\n"; 11305155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 11315155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11325155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 11335155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test{'expected-exit'} = 0; 11345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'expected-stdout'} 11365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru && defined $test{'expected-stdout-pattern'}) 11375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru { 11385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: can't use both expected-stdout and expected-stdout-pattern\n"; 11395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 11405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'expected-stderr'} 11425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru && defined $test{'expected-stderr-pattern'}) 11435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru { 11445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: can't use both expected-stderr and expected-stderr-pattern\n"; 11455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 11465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $test{'time-limit'}) { 11485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($test{'time-limit'} !~ /^\d+$/ || $test{'time-limit'} == 0) { 11495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR 11505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$prog:$test{':long-name'}: bad value for time-limit field\n"; 11515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 11525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif (defined $default_time_limit) { 11545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $test{'time-limit'} = $default_time_limit; 11555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (defined $known_tests{$test{'name'}}) { 11585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: warning: duplicate test name ${test{'name'}}\n"; 11595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 11605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $known_tests{$test{'name'}} = 1; 11615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11625155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return 1; 11635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 11645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 11665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querutty_msg 11675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 11685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($msg) = @_; 11695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru open(TTY, "> /dev/tty") || return 0; 11715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print TTY $msg; 11725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru close(TTY); 11735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return 1; 11745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 11755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 11775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querunever_called_funcs 11785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 11795155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return 0; 11805155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru &tty_msg("hi\n"); 11815155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru &never_called_funcs(); 11825155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru &catch_sigalrm(); 11835155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $old_env{'foo'} = 'bar'; 11845155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $internal_test_fields{'foo'} = 'bar'; 11855155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 11865155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11875155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 11885155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querucheck_file_result 11895155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 11905155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local(*test) = @_; 11915155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11925155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return '' if (!defined $test{'file-result'}); 11935155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11945155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($why) = ''; 11955155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($i); 11965155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local($type, $perm, $uid, $gid, $rest, $c, $len, $name); 11975155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local(@stbuf); 11985155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 11995155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru for ($i = 0; $i < $test{'file-result'}; $i++) { 12005155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $val = $test{"file-result:$i"}; 12015155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 12025155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru # format is: type perm "name" 12035155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru ($type, $perm, $uid, $gid, $matchType, $rest) = 12045155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru split(' ', $val, 6); 12055155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $c = substr($rest, 0, 1); 12065155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $len = index($rest, $c, 1) - 1; 12075155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $name = substr($rest, 1, $len); 12085155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $rest = substr($rest, 2 + $len); 12095155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $perm = oct($perm) if $perm =~ /^\d+$/; 12105155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 12115155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru @stbuf = lstat($name); 12125155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!@stbuf) { 12135155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\texpected $type \"$name\" not created\n"; 12145155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru next; 12155155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 12165155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($perm ne '*' && ($stbuf[2] & 07777) != $perm) { 12175155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\t$type \"$name\" has unexpected permissions\n"; 12185155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= sprintf("\t\texpected 0%o, found 0%o\n", 12195155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $perm, $stbuf[2] & 07777); 12205155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 12215155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($uid ne '*' && $stbuf[4] != $uid) { 12225155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\t$type \"$name\" has unexpected user-id\n"; 12235155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= sprintf("\t\texpected %d, found %d\n", 12245155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $uid, $stbuf[4]); 12255155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 12265155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($gid ne '*' && $stbuf[5] != $gid) { 12275155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\t$type \"$name\" has unexpected group-id\n"; 12285155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= sprintf("\t\texpected %d, found %d\n", 12295155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $gid, $stbuf[5]); 12305155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 12315155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 12325155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($type eq 'file') { 12335155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (-l _ || ! -f _) { 12345155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\t$type \"$name\" is not a regular file\n"; 12355155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 12365155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local $tmp = &check_output($test{'long-name'}, $name, 12375155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$type contents in \"$name\"", 12385155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $matchType eq 'exact' ? $rest : undef 12395155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $matchType eq 'pattern' ? $rest : undef); 12405155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef if (!defined $tmp); 12415155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= $tmp; 12425155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 12435155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($type eq 'dir') { 12445155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if ($rest !~ /^\s*$/) { 12455155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: file-result test for directory $name should not have content specified\n"; 12465155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 12475155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 12485155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (-l _ || ! -d _) { 12495155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\t$type \"$name\" is not a directory\n"; 12505155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 12515155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } elsif ($type eq 'symlink') { 12525155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!-l _) { 12535155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= "\t$type \"$name\" is not a symlink\n"; 12545155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } else { 12555155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local $content = readlink($name); 12565155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru if (!defined $content) { 12575155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR "$prog:$test{':long-name'}: file-result test for $type $name failed - could not readlink - $!\n"; 12585155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef; 12595155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 12605155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru local $tmp = &compare_output($test{'long-name'}, 12615155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru "$type contents in \"$name\"", 12625155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $matchType eq 'exact' ? $rest : undef 12635155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $matchType eq 'pattern' ? $rest : undef); 12645155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return undef if (!defined $tmp); 12655155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru $why .= $tmp; 12665155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 12675155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 12685155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru } 12695155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 12705155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru return $why; 12715155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 12725155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru 12735155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Querusub 12745155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste QueruHELP_MESSAGE 12755155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru{ 12765155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru print STDERR $Usage; 12775155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru exit 0; 12785155f1c7438ef540d7b25eb70aa1639579795b07Jean-Baptiste Queru} 1279