From 01599a0570d858b0ad6e00a32cc7f7e70154059d Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb62281@gmail.com>
Date: Sat, 8 Dec 2018 17:28:51 +1100
Subject: 	* NEWS: Document 'testsuite' command. 	* doc/dejagnu.texi
 (testsuite procedure): Document multiplex entry 	point and "testsuite
 file" command. 	* lib/framework.exp (testsuite): New proc for
 multiplex commands. 	(testsuite_file): New proc implementing "testsuite
 file". 	* testsuite/runtest.all/testsuite_file.test: New file. 	*
 runtest.exp: Expect to find testsuite in ${srcdir}/testsuite, 	but also
 search $srcdir itself. 	(load_lib): Add explicit search for
 testsuite-local libraries. 	(load_tool_init): Use $testsuitedir in search.
 	(load_config): Use $testsuitedir instead of $srcdir. 
 (load_tool_target_config): Likewise.

	Add variable "testsuitedir" for testsuite root directory.

	Add internal global variables "testbuilddir" and "testdir" for use
	by "testsuite file".

	Ensure that $testsuitedir, $testbuilddir, and $objdir also avoid
	duplicated path delimiters.

	Add warning if no tests are found and fallback method of searching
	$srcdir is used.

Signed-off-by: Ben Elliston <bje@gnu.org>
---
 ChangeLog                                 |  26 ++++
 NEWS                                      |   6 +
 doc/dejagnu.texi                          |  58 +++++++-
 lib/framework.exp                         |  64 +++++++++
 runtest.exp                               |  97 +++++++++++---
 testsuite/runtest.all/testsuite_file.test | 211 ++++++++++++++++++++++++++++++
 6 files changed, 439 insertions(+), 23 deletions(-)
 create mode 100644 testsuite/runtest.all/testsuite_file.test

diff --git a/ChangeLog b/ChangeLog
index 2cb8cec..4be9490 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,29 @@
+2018-12-08  Jacob Bachmeyer  <jcb62281@gmail.com>
+
+	* NEWS: Document 'testsuite' command.
+	* doc/dejagnu.texi (testsuite procedure): Document multiplex entry
+	point and "testsuite file" command.
+	* lib/framework.exp (testsuite): New proc for multiplex commands.
+	(testsuite_file): New proc implementing "testsuite file".
+	* testsuite/runtest.all/testsuite_file.test: New file.
+	* runtest.exp: Expect to find testsuite in ${srcdir}/testsuite,
+	but also search $srcdir itself.
+	(load_lib): Add explicit search for testsuite-local libraries.
+	(load_tool_init): Use $testsuitedir in search.
+	(load_config): Use $testsuitedir instead of $srcdir.
+	(load_tool_target_config): Likewise.
+
+	Add variable "testsuitedir" for testsuite root directory.
+
+	Add internal global variables "testbuilddir" and "testdir" for use
+	by "testsuite file".
+
+	Ensure that $testsuitedir, $testbuilddir, and $objdir also avoid
+	duplicated path delimiters.
+
+	Add warning if no tests are found and fallback method of searching
+	$srcdir is used.
+
 2018-12-08  Ben Elliston  <bje@gnu.org>
 
 	* testsuite/lib/libsup.exp (start_expect): Brace commands in if
diff --git a/NEWS b/NEWS
index 35466ce..afdfbcc 100644
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,12 @@ Changes since 1.6.2:
    computes a relative file name to a given destination from a given base.
 4. The utility procedure 'grep' now accepts a '-n' option that
    includes line numbers in the output, consistent with GNU grep.
+5. A new 'testsuite' library procedure is provided for retrieving or
+   providing information about the current testsuite. Initially, the
+   'testsuite file' command returns an absolute file name specified
+   relative to either the testsuite source or object trees. This
+   enables testsuites to not have to access the $subdir internal
+   DejaGnu variable.
 
 Changes since 1.6.1:
 
diff --git a/doc/dejagnu.texi b/doc/dejagnu.texi
index 32ef3e6..1a524f0 100644
--- a/doc/dejagnu.texi
+++ b/doc/dejagnu.texi
@@ -2372,6 +2372,7 @@ DejaGnu provides these Tcl procedures.
 * clear_xfail Procedure: clear_xfail procedure
 * verbose Procedure: verbose procedure
 * load_lib Procedure: load_lib procedure
+* testsuite Procedure: testsuite procedure
 @end menu
 
 @node open_logs procedure, close_logs procedure, , Core Internal Procedures
@@ -2900,7 +2901,7 @@ Log the @i{message} into an XML file.
 Print @i{message} without a trailing newline.
 
 @item @code{--}
-Use this option if @i{message} begins with '-'.
+Use this option if @i{message} begins with @samp{-}.
 
 @item @code{message}
 The log messsage.
@@ -2909,7 +2910,7 @@ The log messsage.
 The specified log level. The default level is 1.
 @end table
 
-@node load_lib procedure, , verbose procedure, Core Internal Procedures
+@node load_lib procedure, testsuite procedure, verbose procedure, Core Internal Procedures
 @subsubheading load_lib Procedure
 @findex load_lib
 
@@ -2945,6 +2946,59 @@ lappend libdirs $srcdir/../../gcc/testsuite/lib
 load_lib foo.exp
 @end example
 
+@node testsuite procedure,  , load_lib procedure, Core Internal Procedures
+@subsubheading testsuite Procedure
+@findex testsuite
+
+The @code{testsuite} procedure is a multiplex call for retrieving or
+providing information about the current testsuite.
+
+@subsubheading testsuite file
+
+The @code{testsuite file} command returns an absolute file name specified
+relative to either the testsuite source or object trees.
+
+@quotation
+@t{  @b{testsuite file}
+?@b{-source}|@b{-object}?
+@b{-top}|@b{-test}
+?@b{-hypothetical}?
+?@b{--}? @i{name}... }
+@end quotation
+
+Any number of @i{name}s are accepted and combined as if by @code{file
+join} with a directory relevant to the testsuite prepended.
+
+@table @asis
+
+@item @code{-object}
+Return a file name in the object tree.
+
+@item @code{-source}
+Return a file name in the source tree.
+
+@item @code{-top}
+Prepend the @code{testsuite} directory itself.
+
+@item @code{-test}
+Prepend the directory containing the current test script.
+
+@item @code{-hypothetical}
+Allow the returned value to imply directories that do not exist.
+
+@item @code{--}
+Use this option if the first @i{name} could begin with @samp{-}.
+
+@end table
+
+One of @code{-top} or @code{-test} must be given; an error is raised
+otherwise.
+
+Unless the @code{-hypothetical} option is given, any directories implied
+by the returned value will exist upon return.  Implied directories are
+created in the object tree if needed.  An error is raised if an implied
+directory does not exist in the source tree.
+
 @node Procedures For Remote Communication, connprocs, Core Internal Procedures, Built-in Procedures
 @section Procedures For Remote Communication
 
diff --git a/lib/framework.exp b/lib/framework.exp
index 3ca5728..9581513 100644
--- a/lib/framework.exp
+++ b/lib/framework.exp
@@ -1042,3 +1042,67 @@ proc incr_count { name args } {
 	perror "$name doesn't exist in incr_count"
     }
 }
+
+## API implementations and multiplex calls
+
+# Return or provide information about the current testsuite.  (multiplex)
+#
+proc testsuite { subcommand args } {
+    if { $subcommand eq "file" } {
+	testsuite_file $args
+    } else {
+	error "unknown \"testsuite\" command: testsuite $subcommand $args"
+    }
+}
+
+# Return a full file name in or near the testsuite
+#
+proc testsuite_file { argv } {
+    global testsuitedir testbuilddir testdir
+    verbose "entering testsuite file $argv" 3
+    set argc [llength $argv]
+    set dir_must_exist true
+    set basedir $testsuitedir
+    for { set argi 0 } { $argi < $argc } { incr argi } {
+	set arg [lindex $argv $argi]
+	if { $arg eq "--" } { # explicit end of arguments
+	    break
+	} elseif { $arg eq "-object" } {
+	    set basedir $testbuilddir
+	} elseif { $arg eq "-source" } {
+	    set basedir $testsuitedir
+	} elseif { $arg eq "-top" } {
+	    set dirtail ""
+	} elseif { $arg eq "-test" } {
+	    set dirtail $testdir
+	} elseif { $arg eq "-hypothetical" } {
+	    set dir_must_exist false
+	} elseif { [string match "-*" $arg] } {
+	    error "testsuite file: unrecognized flag [lindex $argv $argi]"
+	} else { # implicit end of arguments
+	    break
+	}
+    }
+    if { [lindex $argv $argi] eq "--" } { incr argi }
+    if { ![info exists dirtail] } {
+	error "testsuite file requires one of -top|-test\n\
+		   but was given: $argv"
+    }
+    if { $dirtail ne "" } {
+	set dirtail [relative_filename $testsuitedir $dirtail]
+    }
+    set result [eval [list file join $basedir $dirtail] [lrange $argv $argi end]]
+
+    verbose "implying: [file dirname $result]" 3
+    if { $dir_must_exist && ![file isdirectory [file dirname $result]] } {
+	if { $basedir eq $testbuilddir } {
+	    file mkdir [file dirname $result]
+	    verbose "making directory" 3
+	} else {
+	    error "directory '[file dirname $result]' does not exist"
+	}
+    }
+
+    verbose "leaving testsuite file: $result" 3
+    return $result
+}
diff --git a/runtest.exp b/runtest.exp
index 15cd53f..dca60c8 100644
--- a/runtest.exp
+++ b/runtest.exp
@@ -91,6 +91,12 @@ set compiler_flags ""		;# the flags used by the compiler
 set local_init_file	site.exp	;# testsuite-local init file name
 set global_init_file	site.exp	;# global init file name
 
+#
+# These are used to locate parts of the testsuite.
+#
+set testsuitedir	"testsuite"	;# top-level testsuite source directory
+set testbuilddir	"testsuite"	;# top-level testsuite object directory
+
 # Various ccache versions provide incorrect debug info such as ignoring
 # different current directory, breaking GDB testsuite.
 set env(CCACHE_DISABLE) 1
@@ -582,7 +588,8 @@ proc lookfor_file { dir name } {
 # source tree (up one or two levels), then in the current dir.
 #
 proc load_lib { file } {
-    global verbose libdir libdirs srcdir base_dir execpath tool
+    global verbose execpath tool
+    global libdir libdirs srcdir testsuitedir base_dir
     global loaded_libs
 
     if {[info exists loaded_libs($file)]} {
@@ -590,7 +597,11 @@ proc load_lib { file } {
     }
 
     set loaded_libs($file) ""
-    set search_dirs [list ../lib $libdir $libdir/lib [file dirname [file dirname $srcdir]]/dejagnu/lib $srcdir/lib $execpath/lib . [file dirname [file dirname [file dirname $srcdir]]]/dejagnu/lib]
+    set search_dirs [list ../lib $libdir $libdir/lib]
+    lappend search_dirs [file dirname [file dirname $srcdir]]/dejagnu/lib
+    lappend search_dirs $testsuitedir/lib
+    lappend search_dirs $execpath/lib "."
+    lappend search_dirs [file dirname [file dirname [file dirname $srcdir]]]/dejagnu/lib
     if {[info exists libdirs]} {
 	lappend search_dirs $libdirs
     }
@@ -616,6 +627,11 @@ verbose "Login name is $logname"
 
 load_file [file join $base_dir $local_init_file]
 
+# From this point until the command line is parsed for the second time,
+# some variables are overridden by the local init file.  Most notably,
+# $srcdir is *not* what was given on the command line if Automake is used.
+# Instead, $srcdir is Automake's @srcdir@ for now.
+
 #
 # If objdir didn't get set in $base_dir/$local_init_file, set it to
 # $base_dir.  Make sure we source $objdir/$local_init_file in case
@@ -629,6 +645,38 @@ if { $objdir eq "." || $objdir eq $srcdir } {
     load_file [file join $objdir $local_init_file]
 }
 
+#
+# Find the testsuite.
+#
+
+# The DejaGnu manual has always stated that a testsuite must be in a
+# testsuite/ subdirectory.
+
+if { [file tail $srcdir] eq "testsuite" } {
+    # Subdirectory case -- $srcdir includes testsuite/
+    set testsuitedir $srcdir
+    set testbuilddir $objdir
+} elseif { [file tail $srcdir] ne "testsuite"
+	   && [file isdirectory [file join $srcdir testsuite]] } {
+    # Top-level case -- testsuite in ${srcdir}/testsuite/
+    set testsuitedir [file join $srcdir testsuite]
+    set testbuilddir [file join $objdir testsuite]
+} elseif { $srcdir eq "." && [file tail $base_dir] eq "testsuite" } {
+    # Development scaffold case -- testsuite in ".", but "." is "testsuite"
+    set testsuitedir $base_dir
+    set testbuilddir $base_dir
+} else {
+    if { $testsuitedir eq "testsuite" && $srcdir eq "." && $objdir eq "." } {
+	# Broken legacy case -- testsuite not actually in testsuite/
+	# Produce a warning, but continue.
+	send_error "WARNING: testsuite is not in a testsuite/ directory.\n"
+	set testsuitedir $srcdir
+	set testbuilddir $objdir
+    } else {
+	# Custom case -- all variables are assumed to have been set correctly
+    }
+}
+
 # Well, this just demonstrates the real problem...
 if {![info exists tool_root_dir]} {
     set tool_root_dir [file dirname $objdir]
@@ -639,6 +687,7 @@ if {![info exists tool_root_dir]} {
 
 verbose "Using test sources in $srcdir"
 verbose "Using test binaries in $objdir"
+verbose "Testsuite root is $testsuitedir"
 verbose "Tool root directory is $tool_root_dir"
 
 set execpath [file dirname $argv0]
@@ -924,7 +973,7 @@ if { $target_os eq "" } {
 #
 
 proc load_tool_init { file } {
-    global srcdir
+    global srcdir testsuitedir
     global loaded_libs
 
     if {[info exists loaded_libs(tool/$file)]} {
@@ -933,12 +982,10 @@ proc load_tool_init { file } {
 
     set loaded_libs(tool/$file) ""
 
-    if { [lindex [file split $srcdir] end] ne "testsuite" } {
-	lappend searchpath [file join $srcdir testsuite lib tool]
-	lappend searchpath [file join $srcdir testsuite lib]
-    } else {
-	lappend searchpath [file join $srcdir lib tool]
-    }
+    lappend searchpath [file join $testsuitedir lib tool]
+    lappend searchpath [file join $testsuitedir lib]
+    # for legacy testsuites that might have files in lib/ instead of
+    # testsuite/lib/ in the package source tree; deprecated
     lappend searchpath [file join $srcdir lib]
 
     if { ![search_and_load_file "tool init file" [list $file] $searchpath] } {
@@ -1283,11 +1330,11 @@ proc load_generic_config { name } {
 # Load the tool-specific target description.
 #
 proc load_config { args } {
-    global srcdir
+    global testsuitedir
 
     set found 0
 
-    return [search_and_load_file "tool-and-target-specific interface file" $args [list ${srcdir}/config ${srcdir}/../config ${srcdir}/../../config ${srcdir}/../../../config]]
+    return [search_and_load_file "tool-and-target-specific interface file" $args [list ${testsuitedir}/config ${testsuitedir}/../config ${testsuitedir}/../../config ${testsuitedir}/../../../config]]
 }
 
 #
@@ -1307,7 +1354,7 @@ proc load_config { args } {
 #
 
 proc load_tool_target_config { name } {
-    global target_os libdir srcdir
+    global target_os libdir testsuitedir
 
     set found [load_config "${name}.exp" "${target_os}.exp" "default.exp" "unknown.exp"]
 
@@ -1315,7 +1362,7 @@ proc load_tool_target_config { name } {
 	send_error "WARNING: Couldn't find tool config file for $name, using default.\n"
 	# If we can't load the tool init file, this must be a simple natively hosted
 	# test suite, so we use the default procs for Unix.
-	if { [search_and_load_file "library file" default.exp [list $libdir $libdir/config [file dirname [file dirname $srcdir]]/dejagnu/config $srcdir/config . [file dirname [file dirname [file dirname $srcdir]]]/dejagnu/config]] == 0 } {
+	if { [search_and_load_file "library file" default.exp [list $libdir $libdir/config [file dirname [file dirname $testsuitedir]]/dejagnu/config $testsuitedir/config . [file dirname [file dirname [file dirname $testsuitedir]]]/dejagnu/config]] == 0 } {
 	    send_error "ERROR: Couldn't find default tool init file.\n"
 	    exit 1
 	}
@@ -1440,12 +1487,16 @@ proc runtest { test_file_name } {
     global errcnt
     global errorInfo
     global tool
+    global testdir
 
     clone_output "Running $test_file_name ..."
     set prms_id	0
     set bug_id	0
     set test_result ""
 
+    # set testdir so testsuite file -test has a starting point
+    set testdir [file dirname $test_file_name]
+
     if {[file exists $test_file_name]} {
 	set timestart [timestamp]
 
@@ -1589,6 +1640,9 @@ if {[info exists errorInfo]} {
 }
 # make sure we have only single path delimiters
 regsub -all "\(\[^/\]\)//*" $srcdir "\\1/" srcdir
+regsub -all "\(\[^/\]\)//*" $objdir "\\1/" objdir
+regsub -all "\(\[^/\]\)//*" $testsuitedir "\\1/" testsuitedir
+regsub -all "\(\[^/\]\)//*" $testbuilddir "\\1/" testbuilddir
 
 if {![info exists target_list]} {
     # Make sure there is at least one target machine. It's probably a Unix box,
@@ -1690,16 +1744,17 @@ foreach current_target $target_list {
 	}
 
 	# look for the top level testsuites. if $tool doesn't
-	# exist and there are no subdirectories in $srcdir, then
-	# we default to srcdir.
-	set test_top_dirs [lsort [getdirs -all ${srcdir} "${tool}*"]]
+	# exist and there are no subdirectories in $testsuitedir, then
+	# we print a warning and default to srcdir.
+	set test_top_dirs [lsort [getdirs -all ${testsuitedir} "${tool}*"]]
 	if { ${test_top_dirs} eq "" } {
+	    send_error "WARNING: could not find testsuite; trying ${srcdir}.\n"
 	    set test_top_dirs ${srcdir}
 	} else {
 	    # JYG:
 	    # DejaGNU's notion of test tree and test files is very
 	    # general:
-	    # given ${srcdir} and ${tool}, any subdirectory (at any
+	    # given ${testsuitedir} and ${tool}, any subdirectory (at any
 	    # level deep) with the "${tool}" prefix starts a test tree
 	    # given a test tree, any *.exp file underneath (at any
 	    # level deep) is a test file.
@@ -1717,7 +1772,7 @@ foreach current_target $target_list {
 	    # Since ${tool} may be g++, etc. which could confuse
 	    # regexp, we cannot do the simpler test:
 	    #     ...
-	    #     if [regexp "${srcdir}/.*${tool}.*/.*${tool}.*" ${dir}]
+	    #     if [regexp "${testsuitedir}/.*${tool}.*/.*${tool}.*" ${dir}]
 	    #     ...
 	    # instead, we rely on the fact that test_top_dirs is
 	    # a sorted list of entries, and any entry that contains
@@ -1743,8 +1798,8 @@ foreach current_target $target_list {
 	set testlist ""
 	if {[array exists all_runtests]} {
 	    foreach x [array names all_runtests] {
-		verbose "trying to glob ${srcdir}/${x}" 2
-		set s [glob -nocomplain ${srcdir}/$x]
+		verbose "trying to glob ${testsuitedir}/${x}" 2
+		set s [glob -nocomplain ${testsuitedir}/$x]
 		if { $s ne "" } {
 		    set testlist [concat $testlist $s]
 		}
@@ -1777,7 +1832,7 @@ foreach current_target $target_list {
 	    # Go digging for tests.
 	    #
 	    foreach dir "${test_top_dirs}" {
-		if { ${dir} != ${srcdir} } {
+		if { ${dir} ne ${testsuitedir} } {
 		    # Ignore this directory if is a directory to be
 		    # ignored.
 		    if {[info exists ignoredirs] && $ignoredirs ne ""} {
diff --git a/testsuite/runtest.all/testsuite_file.test b/testsuite/runtest.all/testsuite_file.test
new file mode 100644
index 0000000..c7e13ff
--- /dev/null
+++ b/testsuite/runtest.all/testsuite_file.test
@@ -0,0 +1,211 @@
+# test "testsuite file" API call				-*- Tcl -*-
+
+set srcdir [lindex $argv 0]
+set subdir [lindex $argv 1]
+set objdir [lindex $argv 2]
+
+if [ file exists $objdir/setval.tmp ] {
+    source $objdir/setval.tmp
+} else {
+    puts "ERROR: $objdir/setval.tmp doesn't exist"
+}
+if [ file exists $srcdir/$subdir/default_procs.tcl ] {
+    source "$srcdir/$subdir/default_procs.tcl"
+} else {
+    puts "ERROR: $srcdir/$subdir/default_procs.tcl doesn't exist"
+}
+if [ file exists $srcdir/../lib/framework.exp] {
+    source $srcdir/../lib/framework.exp
+} else {
+    puts "ERROR: $srcdir/../lib/framework.exp doesn't exist"
+}
+if [ file exists $srcdir/../lib/utils.exp] {
+    source $srcdir/../lib/utils.exp
+} else {
+    puts "ERROR: $srcdir/../lib/utils.exp doesn't exist"
+}
+
+# basic tests
+
+set testsuitedir /src/foo/testsuite
+set testbuilddir /build/foo/testsuite
+set testdir [file join $testsuitedir foo.all]
+
+run_tests {
+    { "#" "basic syntax errors" }
+    { lib_errpat_test testsuite { file }
+	"*testsuite file requires one of *-top*-test*"
+	"testsuite file without arguments" }
+    { lib_errpat_test testsuite { file -bogus }
+	"*unrecognized flag -bogus"
+	"testsuite file with bogus flag" }
+    { lib_errpat_test testsuite { file -- }
+	"*testsuite file requires one of *-top*-test*"
+	"testsuite file without directory level flag, only --" }
+    { lib_errpat_test testsuite { file -source }
+	"*testsuite file requires one of *-top*-test*"
+	"testsuite file without directory level flag, only -source" }
+    { lib_errpat_test testsuite { file -object }
+	"*testsuite file requires one of *-top*-test*"
+	"testsuite file without directory level flag, only -object" }
+    { lib_errpat_test testsuite { file -hypothetical }
+	"*testsuite file requires one of *-top*-test*"
+	"testsuite file without directory level flag, only -hypothetical" }
+    { lib_errpat_test testsuite { file -- foo bar }
+	"*testsuite file requires one of *-top*-test*"
+	"testsuite file without directory level flag, only -- and names" }
+    { lib_errpat_test testsuite { file foo bar }
+	"*testsuite file requires one of *-top*-test*"
+	"testsuite file without directory level flag, only names" }
+    { lib_errpat_test testsuite { file -- -top }
+	"*testsuite file requires one of *-top*-test*"
+	"testsuite file with directory level flag after --" }
+    { lib_errpat_test testsuite { file foo -top }
+	"*testsuite file requires one of *-top*-test*"
+	"testsuite file with directory level flag after name" }
+
+    { "#" "basic variable retrieval" }
+    { lib_ret_test testsuite
+	{ file -source -top -hypothetical } "/src/foo/testsuite"
+	"testsuite file -source -top for fixed example" }
+    { lib_ret_test testsuite
+	{ file -top -hypothetical } "/src/foo/testsuite"
+	"testsuite file -top defaults to -source" }
+    { lib_ret_test testsuite
+	{ file -object -top -hypothetical } "/build/foo/testsuite"
+	"testsuite file -object -top for fixed example" }
+    { lib_ret_test testsuite
+	{ file -source -test -hypothetical } "/src/foo/testsuite/foo.all"
+	"testsuite file -source -test for fixed example" }
+    { lib_ret_test testsuite
+	{ file -test -hypothetical } "/src/foo/testsuite/foo.all"
+	"testsuite file -test defaults to -source" }
+    { lib_ret_test testsuite
+	{ file -object -test -hypothetical } "/build/foo/testsuite/foo.all"
+	"testsuite file -object -test for fixed example" }
+
+    { "#" "append file name elements" }
+    { lib_ret_test testsuite
+	{ file -source -top -hypothetical lib foo }
+	"/src/foo/testsuite/lib/foo"
+	"testsuite file -source -top lib foo for fixed example" }
+    { lib_ret_test testsuite
+	{ file -object -top -hypothetical lib foo }
+	"/build/foo/testsuite/lib/foo"
+	"testsuite file -object -top lib foo for fixed example" }
+    { lib_ret_test testsuite
+	{ file -source -test -hypothetical bar }
+	"/src/foo/testsuite/foo.all/bar"
+	"testsuite file -source -test bar for fixed example" }
+    { lib_ret_test testsuite
+	{ file -object -test -hypothetical bar }
+	"/build/foo/testsuite/foo.all/bar"
+	"testsuite file -object -test bar for fixed example" }
+
+    { "#" "-- properly handled" }
+    { lib_ret_test testsuite
+	{ file -source -top -hypothetical -- -lib -- foo }
+	"/src/foo/testsuite/-lib/--/foo"
+	"testsuite file -source -top -- -lib -- foo for fixed example" }
+    { lib_ret_test testsuite
+	{ file -object -top -hypothetical -- -lib -foo }
+	"/build/foo/testsuite/-lib/-foo"
+	"testsuite file -object -top -- -lib -foo for fixed example" }
+    { lib_ret_test testsuite
+	{ file -source -test -hypothetical -- bar -object }
+	"/src/foo/testsuite/foo.all/bar/-object"
+	"testsuite file -source -test -- bar -object for fixed example" }
+    { lib_ret_test testsuite
+	{ file -object -test -hypothetical -- -bar }
+	"/build/foo/testsuite/foo.all/-bar"
+	"testsuite file -object -test -- -bar for fixed example" }
+
+    { "#" "apparent command substitutions are safe" }
+    { lib_ret_test testsuite
+	{ file -source -top -hypothetical lib foo [bogus] }
+	"/src/foo/testsuite/lib/foo/[bogus]"
+	"testsuite file -source -top foo [bogus] for fixed example" }
+    { lib_ret_test testsuite
+	{ file -object -top -hypothetical lib foo [bogus] }
+	"/build/foo/testsuite/lib/foo/[bogus]"
+	"testsuite file -object -top foo [bogus] for fixed example" }
+    { lib_ret_test testsuite
+	{ file -source -test -hypothetical bar [bogus] }
+	"/src/foo/testsuite/foo.all/bar/[bogus]"
+	"testsuite file -source -test bar [bogus] for fixed example" }
+    { lib_ret_test testsuite
+	{ file -object -test -hypothetical bar [bogus] }
+	"/build/foo/testsuite/foo.all/bar/[bogus]"
+	"testsuite file -object -test bar [bogus] for fixed example" }
+
+    { "#" "apparent variable substitutions are safe" }
+    { lib_ret_test testsuite
+	{ file -source -top -hypothetical lib foo $bogus }
+	"/src/foo/testsuite/lib/foo/$bogus"
+	"testsuite file -source -top foo $bogus for fixed example" }
+    { lib_ret_test testsuite
+	{ file -object -top -hypothetical lib foo $bogus }
+	"/build/foo/testsuite/lib/foo/$bogus"
+	"testsuite file -object -top foo $bogus for fixed example" }
+    { lib_ret_test testsuite
+	{ file -source -test -hypothetical bar $bogus }
+	"/src/foo/testsuite/foo.all/bar/$bogus"
+	"testsuite file -source -test bar $bogus for fixed example" }
+    { lib_ret_test testsuite
+	{ file -object -test -hypothetical bar $bogus }
+	"/build/foo/testsuite/foo.all/bar/$bogus"
+	"testsuite file -object -test bar $bogus for fixed example" }
+}
+
+set testsuitedir $srcdir
+set testbuilddir $objdir
+set testdir [file join $srcdir $subdir]
+
+run_tests [subst -nocommands {
+    { lib_ret_test testsuite { file -source -top } $srcdir
+	"testsuite file -source -top" }
+    { lib_ret_test testsuite { file -source -test } $testdir
+	"testsuite file -source -test" }
+    { lib_ret_test testsuite { file -object -top } $objdir
+	"testsuite file -object -top" }
+    { lib_errpat_test testsuite { file -source -test {[bogus]} foo }
+	"directory '*\\\\[bogus\\\\]' does not exist"
+	"testsuite file raises error on bogus source directory" }
+}]
+
+# test object directory creation
+
+if { [file isdirectory [file join $objdir empty-test-dir]] } {
+    file delete -force -- [file join $objdir empty-test-dir]
+}
+if { [file isdirectory [file join $objdir empty-test-dir]] } {
+    perror "[file join $objdir empty-test-dir] exists and cannot be removed"
+}
+
+run_tests [subst {
+    { lib_ret_test testsuite
+	{ file -object -top -hypothetical empty-test-dir foo }
+	[file join $objdir empty-test-dir foo]
+	"testsuite file implying hypothetical directory" }
+}]
+
+if { ![file isdirectory [file join $objdir empty-test-dir]] } {
+    puts "PASSED: testsuite file does not create hypothetical implied directory"
+} else {
+    puts "FAILED: testsuite file does not create hypothetical implied directory"
+}
+
+run_tests [subst {
+    { lib_ret_test testsuite
+	{ file -object -top empty-test-dir foo }
+	[file join $objdir empty-test-dir foo]
+	"testsuite file implying new object directory" }
+}]
+
+if { [file isdirectory [file join $objdir empty-test-dir]] } {
+    puts "PASSED: testsuite file creates new implied object directory"
+} else {
+    puts "FAILED: testsuite file creates new implied object directory"
+}
+
+file delete -force [file join $objdir empty-test-dir]
-- 
cgit v1.1