PATCH: add "testsuite file" API call

[Jacob Bachmeyer]

This patch adds an API multiplex entry "testsuite" and a command using 
it:  testsuite file.  There are plans for other commands in this space 
later and "testsuite file" provides an alternative in test scripts to 
using the "*dir" variables, which can be deprecated in the future and 
will be harder to provide in slave interpreters.

Note that the "subdir" variable must remain relative to $srcdir, not 
$testsuitedir, to preserve backwards compatibility.

Generally, the "subdir" variable should probably be deprecated anyway:  
"$srcdir/$subdir" is "[file dirname [info script]]" in modern Tcl, but 
"[testsuite file -source -test]" or the shorthand "[testsuite file 
-test]" will definitely work with future use of slave interpreters, even 
if we use safe interpreters ("strict" mode?) that lack the "file" command.

Additionally, "testsuite file" accepts any number of name components, so 
it can also "absorb" a call to [file join] such that 
"$srcdir/$subdir/foo/bar" becomes "[testsuite file -source -test foo 
bar]", although a mechanical translation yielding "[testsuite file 
-source -test]/foo/bar" will still work if "$srcdir/$subdir/foo/bar" 
worked before.  Using "[testsuite file -object -test]" can also replace 
"$objdir/$subdir".  I believe that "testsuite file" covers all uses of 
$subdir currently.

----
ChangeLog entries:
        * 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".

        * runtest.exp: Expect to find testsuite in ${srcdir}/testsuite,
        but also search $srcdir itself.

        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.

        (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.

        * testsuite/runtest.all/testsuite_file.test: New file.
----
patch:
----
diff --git a/doc/dejagnu.texi b/doc/dejagnu.texi
index 32ef3e6..d36d71f 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
@@ -2909,7 +2910,7 @@ The log messsage.
The specified log level. The default level is 1.
@end table

address@hidden load_lib procedure, , verbose procedure, Core Internal Procedures
address@hidden 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

address@hidden testsuite procedure,  , load_lib procedure, Core Internal 
Procedures
address@hidden testsuite Procedure
address@hidden testsuite
+
+The @code{testsuite} procedure is a multiplex call for retrieving or
+providing information about the current testsuite.
+
address@hidden testsuite file
+
+The @code{testsuite file} command returns an absolute file name specified
+relative to either the testsuite source or object trees.
+
address@hidden
address@hidden  @b{testsuite file}
address@hidden|@b{-object}?
address@hidden|@b{-test}
address@hidden
address@hidden @i{name}... }
address@hidden 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.
+
address@hidden @asis
+
address@hidden @code{-object}
+Return a file name in the object tree.
+
address@hidden @code{-source}
+Return a file name in the source tree.
+
address@hidden @code{-top}
+Prepend the @code{testsuite} directory itself.
+
address@hidden @code{-test}
+Prepend the directory containing the current test script.
+
address@hidden @code{-hypothetical}
+Allow the returned value to imply directories that do not exist.
+
address@hidden @code{--}
+Use this option if the first @i{name} could begin with '-'.
+
address@hidden table
+
+One of @b{-top} or @b{-test} must be given; an error is raised
+otherwise.
+
+Unless the @b{-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]
----


-- Jacob