* 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>

1 files changed, 64 insertions, 0 deletions

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
+}