1a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner#!/usr/bin/perl 2a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# -*-perl-*- 3a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# 4a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# Modification history: 5a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# Written 91-12-02 through 92-01-01 by Stephen McGee. 6a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# Modified 92-02-11 through 92-02-22 by Chris Arthur to further generalize. 7a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# 8a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 9a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. 10a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# This file is part of GNU Make. 11a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# 12a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# GNU Make is free software; you can redistribute it and/or modify it under the 13a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# terms of the GNU General Public License as published by the Free Software 14a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# Foundation; either version 2, or (at your option) any later version. 15a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# 16a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# GNU Make is distributed in the hope that it will be useful, but WITHOUT ANY 17a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR 18a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# A PARTICULAR PURPOSE. See the GNU General Public License for more details. 19a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# 20a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# You should have received a copy of the GNU General Public License along with 21a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# GNU Make; see the file COPYING. If not, write to the Free Software 22a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. 23a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 24a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 25a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# Test driver routines used by a number of test suites, including 26a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# those for SCS, make, roll_dir, and scan_deps (?). 27a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# 28a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# this routine controls the whole mess; each test suite sets up a few 29a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# variables and then calls &toplevel, which does all the real work. 30a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 31a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# $Id: test_driver.pl,v 1.19 2006/03/10 02:20:45 psmith Exp $ 32a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 33a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 34a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# The number of test categories we've run 35a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner$categories_run = 0; 36a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# The number of test categroies that have passed 37a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner$categories_passed = 0; 38a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# The total number of individual tests that have been run 39a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner$total_tests_run = 0; 40a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# The total number of individual tests that have passed 41a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner$total_tests_passed = 0; 42a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# The number of tests in this category that have been run 43a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner$tests_run = 0; 44a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# The number of tests in this category that have passed 45a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner$tests_passed = 0; 46a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 47a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 48a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# Yeesh. This whole test environment is such a hack! 49a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner$test_passed = 1; 50a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 51a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 52a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# %makeENV is the cleaned-out environment. 53a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner%makeENV = (); 54a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 55a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# %extraENV are any extra environment variables the tests might want to set. 56a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# These are RESET AFTER EVERY TEST! 57a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner%extraENV = (); 58a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 59a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# %origENV is the caller's original environment 60a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner%origENV = %ENV; 61a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 62a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub resetENV 63a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 64a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # We used to say "%ENV = ();" but this doesn't work in Perl 5.000 65a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # through Perl 5.004. It was fixed in Perl 5.004_01, but we don't 66a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # want to require that here, so just delete each one individually. 67a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $v (keys %ENV) { 68a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner delete $ENV{$v}; 69a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 70a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 71a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner %ENV = %makeENV; 72a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $v (keys %extraENV) { 73a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $ENV{$v} = $extraENV{$v}; 74a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner delete $extraENV{$v}; 75a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 76a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 77a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 78a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub toplevel 79a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 80a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # Pull in benign variables from the user's environment 81a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # 82a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach (# UNIX-specific things 83a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 'TZ', 'LANG', 'TMPDIR', 'HOME', 'USER', 'LOGNAME', 'PATH', 84a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # Purify things 85a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 'PURIFYOPTIONS', 86a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # Windows NT-specific stuff 87a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 'Path', 'SystemRoot', 88a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # DJGPP-specific stuff 89a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 'DJDIR', 'DJGPP', 'SHELL', 'COMSPEC', 'HOSTNAME', 'LFN', 90a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 'FNCASE', '387', 'EMU387', 'GROUP' 91a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner ) { 92a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $makeENV{$_} = $ENV{$_} if $ENV{$_}; 93a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 94a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 95a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # Replace the environment with the new one 96a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # 97a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner %origENV = %ENV; 98a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 99a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner resetENV(); 100a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 101a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $| = 1; # unbuffered output 102a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 103a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $debug = 0; # debug flag 104a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $profile = 0; # profiling flag 105a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $verbose = 0; # verbose mode flag 106a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $detail = 0; # detailed verbosity 107a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $keep = 0; # keep temp files around 108a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $workdir = "work"; # The directory where the test will start running 109a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $scriptdir = "scripts"; # The directory where we find the test scripts 110a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $tmpfilesuffix = "t"; # the suffix used on tmpfiles 111a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $default_output_stack_level = 0; # used by attach_default_output, etc. 112a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $default_input_stack_level = 0; # used by attach_default_input, etc. 113a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $cwd = "."; # don't we wish we knew 114a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $cwdslash = ""; # $cwd . $pathsep, but "" rather than "./" 115a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 116a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &get_osname; # sets $osname, $vos, $pathsep, and $short_filenames 117a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 118a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &set_defaults; # suite-defined 119a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 120a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &parse_command_line (@ARGV); 121a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 122a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "OS name = `$osname'\n" if $debug; 123a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 124a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $workpath = "$cwdslash$workdir"; 125a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $scriptpath = "$cwdslash$scriptdir"; 126a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 127a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &set_more_defaults; # suite-defined 128a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 129a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &print_banner; 130a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 131a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (-d $workpath) 132a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 133a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "Clearing $workpath...\n"; 134a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &remove_directory_tree("$workpath/") 135a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("Couldn't wipe out $workpath\n"); 136a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 137a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner else 138a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 139a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner mkdir ($workpath, 0777) || &error ("Couldn't mkdir $workpath: $!\n"); 140a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 141a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 142a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (!-d $scriptpath) 143a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 144a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &error ("Failed to find $scriptpath containing perl test scripts.\n"); 145a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 146a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 147a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (@TESTS) 148a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 149a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "Making work dirs...\n"; 150a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $test (@TESTS) 151a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 152a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($test =~ /^([^\/]+)\//) 153a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 154a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $dir = $1; 155a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner push (@rmdirs, $dir); 156a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner -d "$workpath/$dir" 157a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || mkdir ("$workpath/$dir", 0777) 158a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("Couldn't mkdir $workpath/$dir: $!\n"); 159a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 160a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 161a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 162a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner else 163a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 164a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "Finding tests...\n"; 165a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner opendir (SCRIPTDIR, $scriptpath) 166a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("Couldn't opendir $scriptpath: $!\n"); 167a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner @dirs = grep (!/^(\..*|CVS|RCS)$/, readdir (SCRIPTDIR) ); 168a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner closedir (SCRIPTDIR); 169a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $dir (@dirs) 170a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 171a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner next if ($dir =~ /^(\..*|CVS|RCS)$/ || ! -d "$scriptpath/$dir"); 172a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner push (@rmdirs, $dir); 173a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner mkdir ("$workpath/$dir", 0777) 174a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("Couldn't mkdir $workpath/$dir: $!\n"); 175a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner opendir (SCRIPTDIR, "$scriptpath/$dir") 176a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("Couldn't opendir $scriptpath/$dir: $!\n"); 177a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner @files = grep (!/^(\..*|CVS|RCS|.*~)$/, readdir (SCRIPTDIR) ); 178a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner closedir (SCRIPTDIR); 179a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $test (@files) 180a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 181a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner -d $test and next; 182a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner push (@TESTS, "$dir/$test"); 183a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 184a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 185a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 186a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 187a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (@TESTS == 0) 188a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 189a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &error ("\nNo tests in $scriptpath, and none were specified.\n"); 190a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 191a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 192a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\n"; 193a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 194a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &run_each_test; 195a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 196a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $dir (@rmdirs) 197a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 198a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner rmdir ("$workpath/$dir"); 199a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 200a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 201a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $| = 1; 202a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 203a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $categories_failed = $categories_run - $categories_passed; 204a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $total_tests_failed = $total_tests_run - $total_tests_passed; 205a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 206a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($total_tests_failed) 207a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 208a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\n$total_tests_failed Test"; 209a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "s" unless $total_tests_failed == 1; 210a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print " in $categories_failed Categor"; 211a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print ($categories_failed == 1 ? "y" : "ies"); 212a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print " Failed (See .$diffext files in $workdir dir for details) :-(\n\n"; 213a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return 0; 214a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 215a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner else 216a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 217a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\n$total_tests_passed Test"; 218a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "s" unless $total_tests_passed == 1; 219a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print " in $categories_passed Categor"; 220a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print ($categories_passed == 1 ? "y" : "ies"); 221a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print " Complete ... No Failures :-)\n\n"; 222a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return 1; 223a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 224a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 225a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 226a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub get_osname 227a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 228a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # Set up an initial value. In perl5 we can do it the easy way. 229a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # 230a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $osname = defined($^O) ? $^O : ''; 231a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 232a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # See if the filesystem supports long file names with multiple 233a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # dots. DOS doesn't. 234a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $short_filenames = 0; 235a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner (open (TOUCHFD, "> fancy.file.name") && close (TOUCHFD)) 236a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || ($short_filenames = 1); 237a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner unlink ("fancy.file.name") || ($short_filenames = 1); 238a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 239a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (! $short_filenames) { 240a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # Thanks go to meyering@cs.utexas.edu (Jim Meyering) for suggesting a 241a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # better way of doing this. (We used to test for existence of a /mnt 242a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # dir, but that apparently fails on an SGI Indigo (whatever that is).) 243a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # Because perl on VOS translates /'s to >'s, we need to test for 244a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # VOSness rather than testing for Unixness (ie, try > instead of /). 245a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 246a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner mkdir (".ostest", 0777) || &error ("Couldn't create .ostest: $!\n", 1); 247a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner open (TOUCHFD, "> .ostest>ick") && close (TOUCHFD); 248a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner chdir (".ostest") || &error ("Couldn't chdir to .ostest: $!\n", 1); 249a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 250a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 251a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (! $short_filenames && -f "ick") 252a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 253a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $osname = "vos"; 254a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $vos = 1; 255a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $pathsep = ">"; 256a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 257a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner else 258a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 259a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # the following is regrettably knarly, but it seems to be the only way 260a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # to not get ugly error messages if uname can't be found. 261a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # Hmmm, BSD/OS 2.0's uname -a is excessively verbose. Let's try it 262a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # with switches first. 263a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner eval "chop (\$osname = `sh -c 'uname -nmsr 2>&1'`)"; 264a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($osname =~ /not found/i) 265a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 266a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $osname = "(something unixy with no uname)"; 267a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 268a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($@ ne "" || $?) 269a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 270a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner eval "chop (\$osname = `sh -c 'uname -a 2>&1'`)"; 271a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($@ ne "" || $?) 272a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 273a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $osname = "(something unixy)"; 274a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 275a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 276a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $vos = 0; 277a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $pathsep = "/"; 278a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 279a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 280a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (! $short_filenames) { 281a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner chdir ("..") || &error ("Couldn't chdir to ..: $!\n", 1); 282a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner unlink (".ostest>ick"); 283a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner rmdir (".ostest") || &error ("Couldn't rmdir .ostest: $!\n", 1); 284a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 285a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 286a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 287a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub parse_command_line 288a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 289a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner @argv = @_; 290a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 291a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # use @ARGV if no args were passed in 292a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 293a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (@argv == 0) 294a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 295a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner @argv = @ARGV; 296a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 297a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 298a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # look at each option; if we don't recognize it, maybe the suite-specific 299a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # command line parsing code will... 300a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 301a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner while (@argv) 302a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 303a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $option = shift @argv; 304a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($option =~ /^-debug$/i) 305a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 306a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\nDEBUG ON\n"; 307a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $debug = 1; 308a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 309a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($option =~ /^-usage$/i) 310a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 311a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &print_usage; 312a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner exit 0; 313a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 314a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($option =~ /^-(h|help)$/i) 315a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 316a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &print_help; 317a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner exit 0; 318a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 319a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($option =~ /^-profile$/i) 320a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 321a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $profile = 1; 322a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 323a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($option =~ /^-verbose$/i) 324a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 325a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $verbose = 1; 326a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 327a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($option =~ /^-detail$/i) 328a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 329a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $detail = 1; 330a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $verbose = 1; 331a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 332a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($option =~ /^-keep$/i) 333a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 334a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $keep = 1; 335a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 336a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif (&valid_option($option)) 337a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 338a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # The suite-defined subroutine takes care of the option 339a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 340a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($option =~ /^-/) 341a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 342a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "Invalid option: $option\n"; 343a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &print_usage; 344a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner exit 0; 345a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 346a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner else # must be the name of a test 347a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 348a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $option =~ s/\.pl$//; 349a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner push(@TESTS,$option); 350a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 351a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 352a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 353a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 354a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub max 355a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 356a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($num) = shift @_; 357a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($newnum); 358a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 359a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner while (@_) 360a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 361a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $newnum = shift @_; 362a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($newnum > $num) 363a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 364a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $num = $newnum; 365a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 366a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 367a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 368a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return $num; 369a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 370a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 371a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub print_centered 372a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 373a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($width, $string) = @_; 374a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($pad); 375a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 376a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (length ($string)) 377a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 378a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $pad = " " x ( ($width - length ($string) + 1) / 2); 379a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "$pad$string"; 380a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 381a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 382a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 383a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub print_banner 384a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 385a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($info); 386a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($line); 387a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($len); 388a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 389a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $info = "Running tests for $testee on $osname\n"; # $testee is suite-defined 390a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $len = &max (length ($line), length ($testee_version), 391a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner length ($banner_info), 73) + 5; 392a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $line = ("-" x $len) . "\n"; 393a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($len < 78) 394a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 395a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $len = 78; 396a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 397a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 398a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &print_centered ($len, $line); 399a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &print_centered ($len, $info); 400a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &print_centered ($len, $testee_version); # suite-defined 401a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &print_centered ($len, $banner_info); # suite-defined 402a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &print_centered ($len, $line); 403a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\n"; 404a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 405a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 406a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub run_each_test 407a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 408a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $categories_run = 0; 409a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 410a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $testname (sort @TESTS) 411a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 412a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner ++$categories_run; 413a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $suite_passed = 1; # reset by test on failure 414a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $num_of_logfiles = 0; 415a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $num_of_tmpfiles = 0; 416a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $description = ""; 417a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $details = ""; 418a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $old_makefile = undef; 419a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $testname =~ s/^$scriptpath$pathsep//; 420a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $perl_testname = "$scriptpath$pathsep$testname"; 421a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $testname =~ s/(\.pl|\.perl)$//; 422a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $testpath = "$workpath$pathsep$testname"; 423a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # Leave enough space in the extensions to append a number, even 424a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # though it needs to fit into 8+3 limits. 425a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($short_filenames) { 426a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $logext = 'l'; 427a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $diffext = 'd'; 428a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $baseext = 'b'; 429a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $extext = ''; 430a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } else { 431a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $logext = 'log'; 432a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $diffext = 'diff'; 433a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $baseext = 'base'; 434a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $extext = '.'; 435a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 436a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $log_filename = "$testpath.$logext"; 437a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $diff_filename = "$testpath.$diffext"; 438a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $base_filename = "$testpath.$baseext"; 439a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $tmp_filename = "$testpath.$tmpfilesuffix"; 440a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 441a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &setup_for_test; # suite-defined 442a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 443a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $output = "........................................................ "; 444a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 445a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner substr($output,0,length($testname)) = "$testname "; 446a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 447a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print $output; 448a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 449a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # Run the actual test! 450a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $tests_run = 0; 451a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $tests_passed = 0; 452a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $code = do $perl_testname; 453a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 454a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $total_tests_run += $tests_run; 455a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $total_tests_passed += $tests_passed; 456a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 457a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # How did it go? 458a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (!defined($code)) 459a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 460a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $suite_passed = 0; 461a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (length ($@)) { 462a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner warn "\n*** Test died ($testname): $@\n"; 463a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } else { 464a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner warn "\n*** Couldn't run $perl_testname\n"; 465a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 466a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 467a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($code == -1) { 468a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $suite_passed = 0; 469a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 470a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($code != 1 && $code != -1) { 471a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $suite_passed = 0; 472a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner warn "\n*** Test returned $code\n"; 473a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 474a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 475a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($suite_passed) { 476a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner ++$categories_passed; 477a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $status = "ok ($tests_passed passed)"; 478a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner for ($i = $num_of_tmpfiles; $i; $i--) 479a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 480a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &rmfiles ($tmp_filename . &num_suffix ($i) ); 481a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 482a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 483a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner for ($i = $num_of_logfiles ? $num_of_logfiles : 1; $i; $i--) 484a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 485a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &rmfiles ($log_filename . &num_suffix ($i) ); 486a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &rmfiles ($base_filename . &num_suffix ($i) ); 487a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 488a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 489a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif (!defined $code || $code > 0) { 490a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $status = "FAILED ($tests_passed/$tests_run passed)"; 491a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 492a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($code < 0) { 493a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $status = "N/A"; 494a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner --$categories_run; 495a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 496a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 497a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # If the verbose option has been specified, then a short description 498a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # of each test is printed before displaying the results of each test 499a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # describing WHAT is being tested. 500a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 501a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($verbose) 502a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 503a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($detail) 504a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 505a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\nWHAT IS BEING TESTED\n"; 506a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "--------------------"; 507a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 508a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\n\n$description\n\n"; 509a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 510a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 511a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # If the detail option has been specified, then the details of HOW 512a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # the test is testing what it says it is testing in the verbose output 513a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # will be displayed here before the results of the test are displayed. 514a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 515a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($detail) 516a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 517a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\nHOW IT IS TESTED\n"; 518a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "----------------"; 519a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\n\n$details\n\n"; 520a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 521a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 522a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "$status\n"; 523a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 524a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 525a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 526a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# If the keep flag is not set, this subroutine deletes all filenames that 527a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# are sent to it. 528a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 529a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub rmfiles 530a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 531a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local(@files) = @_; 532a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 533a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (!$keep) 534a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 535a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return (unlink @files); 536a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 537a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 538a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return 1; 539a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 540a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 541a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub print_standard_usage 542a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 543a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($plname,@moreusage) = @_; 544a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($line); 545a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 546a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "Usage: perl $plname [testname] [-verbose] [-detail] [-keep]\n"; 547a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print " [-profile] [-usage] [-help] " 548a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "[-debug]\n"; 549a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $line (@moreusage) 550a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 551a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print " $line\n"; 552a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 553a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 554a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 555a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub print_standard_help 556a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 557a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local(@morehelp) = @_; 558a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($line); 559a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($tline); 560a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($t) = " "; 561a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 562a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $line = "Test Driver For $testee"; 563a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "$line\n"; 564a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $line = "=" x length ($line); 565a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "$line\n"; 566a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 567a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &print_usage; 568a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 569a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\ntestname\n" 570a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}You may, if you wish, run only ONE test if you know the name\n" 571a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}of that test and specify this name anywhere on the command\n" 572a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}line. Otherwise ALL existing tests in the scripts directory\n" 573a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}will be run.\n" 574a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "-verbose\n" 575a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}If this option is given, a description of every test is\n" 576a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}displayed before the test is run. (Not all tests may have\n" 577a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}descriptions at this time)\n" 578a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "-detail\n" 579a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}If this option is given, a detailed description of every\n" 580a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}test is displayed before the test is run. (Not all tests\n" 581a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}have descriptions at this time)\n" 582a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "-profile\n" 583a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}If this option is given, then the profile file\n" 584a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}is added to other profiles every time $testee is run.\n" 585a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}This option only works on VOS at this time.\n" 586a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "-keep\n" 587a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}You may give this option if you DO NOT want ANY\n" 588a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}of the files generated by the tests to be deleted. \n" 589a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}Without this option, all files generated by the test will\n" 590a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}be deleted IF THE TEST PASSES.\n" 591a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "-debug\n" 592a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}Use this option if you would like to see all of the system\n" 593a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}calls issued and their return status while running the tests\n" 594a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}This can be helpful if you're having a problem adding a test\n" 595a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "${t}to the suite, or if the test fails!\n"; 596a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 597a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $line (@morehelp) 598a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 599a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $tline = $line; 600a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (substr ($tline, 0, 1) eq "\t") 601a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 602a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner substr ($tline, 0, 1) = $t; 603a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 604a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "$tline\n"; 605a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 606a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 607a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 608a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner####################################################################### 609a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner########### Generic Test Driver Subroutines ########### 610a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner####################################################################### 611a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 612a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub get_caller 613a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 614a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($depth); 615a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($package); 616a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($filename); 617a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($linenum); 618a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 619a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $depth = defined ($_[0]) ? $_[0] : 1; 620a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner ($package, $filename, $linenum) = caller ($depth + 1); 621a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return "$filename: $linenum"; 622a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 623a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 624a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub error 625a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 626a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($message) = $_[0]; 627a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($caller) = &get_caller (1); 628a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 629a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (defined ($_[1])) 630a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 631a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $caller = &get_caller ($_[1] + 1) . " -> $caller"; 632a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 633a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 634a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner die "$caller: $message"; 635a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 636a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 637a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub compare_output 638a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 639a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($answer,$logfile) = @_; 640a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($slurp, $answer_matched) = ('', 0); 641a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 642a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "Comparing Output ........ " if $debug; 643a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 644a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $slurp = &read_file_into_string ($logfile); 645a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 646a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # For make, get rid of any time skew error before comparing--too bad this 647a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # has to go into the "generic" driver code :-/ 648a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $slurp =~ s/^.*modification time .*in the future.*\n//gm; 649a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $slurp =~ s/^.*Clock skew detected.*\n//gm; 650a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 651a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner ++$tests_run; 652a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 653a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($slurp eq $answer) { 654a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $answer_matched = 1; 655a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } else { 656a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # See if it is a slash or CRLF problem 657a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($answer_mod) = $answer; 658a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 659a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $answer_mod =~ tr,\\,/,; 660a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $answer_mod =~ s,\r\n,\n,gs; 661a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 662a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $slurp =~ tr,\\,/,; 663a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $slurp =~ s,\r\n,\n,gs; 664a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 665a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $answer_matched = ($slurp eq $answer_mod); 666a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 667a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 668a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($answer_matched && $test_passed) 669a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 670a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "ok\n" if $debug; 671a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner ++$tests_passed; 672a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return 1; 673a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 674a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 675a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (! $answer_matched) { 676a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "DIFFERENT OUTPUT\n" if $debug; 677a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 678a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &create_file (&get_basefile, $answer); 679a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 680a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\nCreating Difference File ...\n" if $debug; 681a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 682a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # Create the difference file 683a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 684a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($command) = "diff -c " . &get_basefile . " " . $logfile; 685a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &run_command_with_output(&get_difffile,$command); 686a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 687a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 688a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $suite_passed = 0; 689a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return 0; 690a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 691a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 692a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub read_file_into_string 693a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 694a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($filename) = @_; 695a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($oldslash) = $/; 696a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 697a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner undef $/; 698a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 699a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner open (RFISFILE, $filename) || return ""; 700a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($slurp) = <RFISFILE>; 701a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner close (RFISFILE); 702a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 703a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $/ = $oldslash; 704a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 705a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return $slurp; 706a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 707a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 708a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub attach_default_output 709a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 710a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($filename) = @_; 711a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($code); 712a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 713a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($vos) 714a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 715a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $code = system "++attach_default_output_hack $filename"; 716a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $code == -2 || &error ("adoh death\n", 1); 717a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return 1; 718a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 719a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 720a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner open ("SAVEDOS" . $default_output_stack_level . "out", ">&STDOUT") 721a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("ado: $! duping STDOUT\n", 1); 722a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner open ("SAVEDOS" . $default_output_stack_level . "err", ">&STDERR") 723a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("ado: $! duping STDERR\n", 1); 724a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 725a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner open (STDOUT, "> " . $filename) 726a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("ado: $filename: $!\n", 1); 727a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner open (STDERR, ">&STDOUT") 728a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("ado: $filename: $!\n", 1); 729a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 730a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $default_output_stack_level++; 731a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 732a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 733a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# close the current stdout/stderr, and restore the previous ones from 734a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# the "stack." 735a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 736a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub detach_default_output 737a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 738a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($code); 739a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 740a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($vos) 741a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 742a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $code = system "++detach_default_output_hack"; 743a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $code == -2 || &error ("ddoh death\n", 1); 744a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return 1; 745a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 746a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 747a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (--$default_output_stack_level < 0) 748a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 749a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &error ("default output stack has flown under!\n", 1); 750a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 751a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 752a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner close (STDOUT); 753a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner close (STDERR); 754a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 755a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner open (STDOUT, ">&SAVEDOS" . $default_output_stack_level . "out") 756a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("ddo: $! duping STDOUT\n", 1); 757a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner open (STDERR, ">&SAVEDOS" . $default_output_stack_level . "err") 758a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("ddo: $! duping STDERR\n", 1); 759a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 760a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner close ("SAVEDOS" . $default_output_stack_level . "out") 761a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("ddo: $! closing SCSDOSout\n", 1); 762a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner close ("SAVEDOS" . $default_output_stack_level . "err") 763a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("ddo: $! closing SAVEDOSerr\n", 1); 764a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 765a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 766a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# run one command (passed as a list of arg 0 - n), returning 0 on success 767a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# and nonzero on failure. 768a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 769a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub run_command 770a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 771a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($code); 772a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 773a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # We reset this before every invocation. On Windows I think there is only 774a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # one environment, not one per process, so I think that variables set in 775a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # test scripts might leak into subsequent tests if this isn't reset--??? 776a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner resetENV(); 777a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 778a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "\nrun_command: @_\n" if $debug; 779a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $code = system @_; 780a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "run_command: \"@_\" returned $code.\n" if $debug; 781a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 782a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return $code; 783a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 784a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 785a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# run one command (passed as a list of arg 0 - n, with arg 0 being the 786a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# second arg to this routine), returning 0 on success and non-zero on failure. 787a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# The first arg to this routine is a filename to connect to the stdout 788a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# & stderr of the child process. 789a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 790a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub run_command_with_output 791a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 792a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($filename) = shift; 793a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($code); 794a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 795a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # We reset this before every invocation. On Windows I think there is only 796a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # one environment, not one per process, so I think that variables set in 797a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner # test scripts might leak into subsequent tests if this isn't reset--??? 798a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner resetENV(); 799a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 800a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &attach_default_output ($filename); 801a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $code = system @_; 802a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &detach_default_output; 803a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 804a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "run_command_with_output: '@_' returned $code.\n" if $debug; 805a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 806a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return $code; 807a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 808a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 809a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# performs the equivalent of an "rm -rf" on the first argument. Like 810a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# rm, if the path ends in /, leaves the (now empty) directory; otherwise 811a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# deletes it, too. 812a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 813a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub remove_directory_tree 814a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 815a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($targetdir) = @_; 816a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($nuketop) = 1; 817a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($ch); 818a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 819a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $ch = substr ($targetdir, length ($targetdir) - 1); 820a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($ch eq "/" || $ch eq $pathsep) 821a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 822a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $targetdir = substr ($targetdir, 0, length ($targetdir) - 1); 823a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $nuketop = 0; 824a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 825a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 826a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (! -e $targetdir) 827a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 828a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return 1; 829a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 830a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 831a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &remove_directory_tree_inner ("RDT00", $targetdir) || return 0; 832a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($nuketop) 833a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 834a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner rmdir $targetdir || return 0; 835a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 836a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 837a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return 1; 838a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 839a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 840a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub remove_directory_tree_inner 841a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 842a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($dirhandle, $targetdir) = @_; 843a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($object); 844a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($subdirhandle); 845a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 846a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner opendir ($dirhandle, $targetdir) || return 0; 847a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $subdirhandle = $dirhandle; 848a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $subdirhandle++; 849a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner while ($object = readdir ($dirhandle)) 850a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 851a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($object =~ /^(\.\.?|CVS|RCS)$/) 852a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 853a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner next; 854a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 855a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 856a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $object = "$targetdir$pathsep$object"; 857a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner lstat ($object); 858a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 859a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (-d _ && &remove_directory_tree_inner ($subdirhandle, $object)) 860a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 861a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner rmdir $object || return 0; 862a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 863a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner else 864a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 865a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner unlink $object || return 0; 866a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 867a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 868a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner closedir ($dirhandle); 869a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return 1; 870a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 871a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 872a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# We used to use this behavior for this function: 873a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# 874a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner#sub touch 875a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner#{ 876a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# local (@filenames) = @_; 877a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# local ($now) = time; 878a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# local ($file); 879a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# 880a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# foreach $file (@filenames) 881a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# { 882a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# utime ($now, $now, $file) 883a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# || (open (TOUCHFD, ">> $file") && close (TOUCHFD)) 884a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# || &error ("Couldn't touch $file: $!\n", 1); 885a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# } 886a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# return 1; 887a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner#} 888a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# 889a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# But this behaves badly on networked filesystems where the time is 890a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# skewed, because it sets the time of the file based on the _local_ 891a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# host. Normally when you modify a file, it's the _remote_ host that 892a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# determines the modtime, based on _its_ clock. So, instead, now we open 893a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# the file and write something into it to force the remote host to set 894a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# the modtime correctly according to its clock. 895a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# 896a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 897a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub touch 898a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 899a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($file); 900a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 901a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $file (@_) { 902a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner (open(T, ">> $file") && print(T "\n") && close(T)) 903a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error("Couldn't touch $file: $!\n", 1); 904a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 905a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 906a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 907a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# Touch with a time offset. To DTRT, call touch() then use stat() to get the 908a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# access/mod time for each file and apply the offset. 909a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 910a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub utouch 911a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 912a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($off) = shift; 913a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($file); 914a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 915a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &touch(@_); 916a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 917a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local (@s) = stat($_[0]); 918a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 919a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner utime($s[8]+$off, $s[9]+$off, @_); 920a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 921a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 922a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# open a file, write some stuff to it, and close it. 923a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 924a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub create_file 925a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 926a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($filename, @lines) = @_; 927a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 928a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner open (CF, "> $filename") || &error ("Couldn't open $filename: $!\n", 1); 929a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $line (@lines) 930a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 931a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print CF $line; 932a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 933a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner close (CF); 934a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 935a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 936a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# create a directory tree described by an associative array, wherein each 937a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# key is a relative pathname (using slashes) and its associated value is 938a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# one of: 939a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# DIR indicates a directory 940a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# FILE:contents indicates a file, which should contain contents +\n 941a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# LINK:target indicates a symlink, pointing to $basedir/target 942a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# The first argument is the dir under which the structure will be created 943a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# (the dir will be made and/or cleaned if necessary); the second argument 944a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# is the associative array. 945a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 946a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub create_dir_tree 947a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 948a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($basedir, %dirtree) = @_; 949a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($path); 950a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 951a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &remove_directory_tree ("$basedir"); 952a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner mkdir ($basedir, 0777) || &error ("Couldn't mkdir $basedir: $!\n", 1); 953a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 954a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $path (sort keys (%dirtree)) 955a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 956a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($dirtree {$path} =~ /^DIR$/) 957a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 958a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner mkdir ("$basedir/$path", 0777) 959a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("Couldn't mkdir $basedir/$path: $!\n", 1); 960a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 961a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($dirtree {$path} =~ /^FILE:(.*)$/) 962a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 963a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &create_file ("$basedir/$path", $1 . "\n"); 964a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 965a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($dirtree {$path} =~ /^LINK:(.*)$/) 966a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 967a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner symlink ("$basedir/$1", "$basedir/$path") 968a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner || &error ("Couldn't symlink $basedir/$path -> $basedir/$1: $!\n", 1); 969a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 970a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner else 971a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 972a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &error ("Bogus dirtree type: \"$dirtree{$path}\"\n", 1); 973a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 974a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 975a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($just_setup_tree) 976a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 977a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner die "Tree is setup...\n"; 978a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 979a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 980a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 981a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# compare a directory tree with an associative array in the format used 982a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# by create_dir_tree, above. 983a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# The first argument is the dir under which the structure should be found; 984a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# the second argument is the associative array. 985a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 986a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub compare_dir_tree 987a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 988a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($basedir, %dirtree) = @_; 989a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($path); 990a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($i); 991a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($bogus) = 0; 992a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($contents); 993a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($target); 994a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($fulltarget); 995a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local ($found); 996a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local (@files); 997a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local (@allfiles); 998a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 999a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner opendir (DIR, $basedir) || &error ("Couldn't open $basedir: $!\n", 1); 1000a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner @allfiles = grep (!/^(\.\.?|CVS|RCS)$/, readdir (DIR) ); 1001a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner closedir (DIR); 1002a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($debug) 1003a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1004a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "dirtree: (%dirtree)\n$basedir: (@allfiles)\n"; 1005a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1006a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1007a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $path (sort keys (%dirtree)) 1008a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1009a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($debug) 1010a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1011a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "Checking $path ($dirtree{$path}).\n"; 1012a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1013a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1014a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $found = 0; 1015a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $i (0 .. $#allfiles) 1016a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1017a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($allfiles[$i] eq $path) 1018a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1019a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner splice (@allfiles, $i, 1); # delete it 1020a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($debug) 1021a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1022a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print " Zapped $path; files now (@allfiles).\n"; 1023a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1024a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner lstat ("$basedir/$path"); 1025a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $found = 1; 1026a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner last; 1027a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1028a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1029a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1030a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (!$found) 1031a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1032a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "compare_dir_tree: $path does not exist.\n"; 1033a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $bogus = 1; 1034a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner next; 1035a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1036a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1037a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($dirtree {$path} =~ /^DIR$/) 1038a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1039a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (-d _ && opendir (DIR, "$basedir/$path") ) 1040a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1041a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner @files = readdir (DIR); 1042a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner closedir (DIR); 1043a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner @files = grep (!/^(\.\.?|CVS|RCS)$/ && ($_ = "$path/$_"), @files); 1044a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner push (@allfiles, @files); 1045a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($debug) 1046a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1047a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print " Read in $path; new files (@files).\n"; 1048a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1049a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1050a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner else 1051a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1052a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "compare_dir_tree: $path is not a dir.\n"; 1053a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $bogus = 1; 1054a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1055a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1056a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($dirtree {$path} =~ /^FILE:(.*)$/) 1057a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1058a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (-l _ || !-f _) 1059a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1060a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "compare_dir_tree: $path is not a file.\n"; 1061a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $bogus = 1; 1062a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner next; 1063a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1064a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1065a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($1 ne "*") 1066a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1067a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $contents = &read_file_into_string ("$basedir/$path"); 1068a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($contents ne "$1\n") 1069a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1070a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "compare_dir_tree: $path contains wrong stuff." 1071a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . " Is:\n$contentsShould be:\n$1\n"; 1072a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $bogus = 1; 1073a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1074a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1075a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1076a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner elsif ($dirtree {$path} =~ /^LINK:(.*)$/) 1077a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1078a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $target = $1; 1079a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (!-l _) 1080a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1081a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "compare_dir_tree: $path is not a link.\n"; 1082a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $bogus = 1; 1083a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner next; 1084a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1085a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1086a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $contents = readlink ("$basedir/$path"); 1087a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $contents =~ tr/>/\//; 1088a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $fulltarget = "$basedir/$target"; 1089a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $fulltarget =~ tr/>/\//; 1090a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (!($contents =~ /$fulltarget$/)) 1091a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1092a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($debug) 1093a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1094a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $target = $fulltarget; 1095a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1096a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "compare_dir_tree: $path should be link to $target, " 1097a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner . "not $contents.\n"; 1098a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $bogus = 1; 1099a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1100a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1101a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner else 1102a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1103a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner &error ("Bogus dirtree type: \"$dirtree{$path}\"\n", 1); 1104a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1105a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1106a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1107a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if ($debug) 1108a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1109a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "leftovers: (@allfiles).\n"; 1110a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1111a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1112a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner foreach $file (@allfiles) 1113a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner { 1114a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner print "compare_dir_tree: $file should not exist.\n"; 1115a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $bogus = 1; 1116a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1117a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1118a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return !$bogus; 1119a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 1120a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1121a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# this subroutine generates the numeric suffix used to keep tmp filenames, 1122a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# log filenames, etc., unique. If the number passed in is 1, then a null 1123a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# string is returned; otherwise, we return ".n", where n + 1 is the number 1124a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# we were given. 1125a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1126a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub num_suffix 1127a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 1128a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($num) = @_; 1129a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1130a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner if (--$num > 0) { 1131a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return "$extext$num"; 1132a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner } 1133a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1134a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return ""; 1135a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 1136a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1137a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# This subroutine returns a log filename with a number appended to 1138a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# the end corresponding to how many logfiles have been created in the 1139a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# current running test. An optional parameter may be passed (0 or 1). 1140a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# If a 1 is passed, then it does NOT increment the logfile counter 1141a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# and returns the name of the latest logfile. If either no parameter 1142a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# is passed at all or a 0 is passed, then the logfile counter is 1143a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# incremented and the new name is returned. 1144a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1145a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub get_logfile 1146a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 1147a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($no_increment) = @_; 1148a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1149a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $num_of_logfiles += !$no_increment; 1150a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1151a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return ($log_filename . &num_suffix ($num_of_logfiles)); 1152a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 1153a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1154a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# This subroutine returns a base (answer) filename with a number 1155a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# appended to the end corresponding to how many logfiles (and thus 1156a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# base files) have been created in the current running test. 1157a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# NO PARAMETERS ARE PASSED TO THIS SUBROUTINE. 1158a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1159a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub get_basefile 1160a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 1161a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return ($base_filename . &num_suffix ($num_of_logfiles)); 1162a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 1163a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1164a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# This subroutine returns a difference filename with a number appended 1165a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# to the end corresponding to how many logfiles (and thus diff files) 1166a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# have been created in the current running test. 1167a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1168a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub get_difffile 1169a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 1170a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return ($diff_filename . &num_suffix ($num_of_logfiles)); 1171a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 1172a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1173a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# just like logfile, only a generic tmp filename for use by the test. 1174a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# they are automatically cleaned up unless -keep was used, or the test fails. 1175a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner# Pass an argument of 1 to return the same filename as the previous call. 1176a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1177a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turnersub get_tmpfile 1178a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner{ 1179a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner local($no_increment) = @_; 1180a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1181a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner $num_of_tmpfiles += !$no_increment; 1182a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1183a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner return ($tmp_filename . &num_suffix ($num_of_tmpfiles)); 1184a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner} 1185a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner 1186a86d4c1bde70365cbbe874ad9ddb3f06916d2085David 'Digit' Turner1; 1187