Add "testsuite can call api" feature test API

5 files changed, 92 insertions, 7 deletions

diff --git a/ChangeLog b/ChangeLog
index 69a80ef..a6aedc6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,20 @@
+2020-06-05  Jacob Bachmeyer  <jcb62281+dev@gmail.com>
+
+	* NEWS: Document new "testsuite can call api" command.
+
+	* doc/dejagnu.texi (testsuite procedure): Document new subcommand
+	"testsuite can call api".
+
+	* lib/framework.exp (testsuite): Add branch for "testsuite can".
+	(testsuite_can): New procedure implementing "testsuite can".
+
+	Add internal array ::dejagnu::apilist to store information for
+	"testsuite can call api" for querying the availability of an API
+	call.  This will allow test scripts to adapt and use new features
+	while still being able to run under older versions of DejaGnu.
+
+	* testsuite/runtest.libs/testsuite_can.test: New file.
+
 2020-06-02  Jacob Bachmeyer  <jcb62281+dev@gmail.com>
 
 	PR 41647
diff --git a/NEWS b/NEWS
index 209e9c4..6111903 100644
--- a/NEWS
+++ b/NEWS
@@ -15,17 +15,19 @@ Changes since 1.6.2:
    retrieving or providing information about the current testsuite.
 6. A command "testsuite file" is added to replace the use of the
    "*dir" variables in test scripts.
-7. A shell command "dejagnu" is added as a place to hang various
+7. A command "testsuite can call api" is added to report the availability
+   of multiplexed API calls.
+8. A shell command "dejagnu" is added as a place to hang various
    auxiliary commands not directly involved with running tests. The
    "runtest" command will remain for that purpose for the foreseeable
    future.
-8. The first auxiliary command is added: "report card". The "dejagnu
+9. The first auxiliary command is added: "report card". The "dejagnu
    report card" command reads DejaGnu summary files and produces a
    compact tabular summary across multiple tools.
-9. A Tcl namespace is now used for some internal procedures and variables.
-   The Tcl namespace ::dejagnu and all child namespaces are entirely
-   internal and should not be mentioned in testsuite code.  Its contents
-   are subject to change without notice, even on point releases.
+10. A Tcl namespace is now used for some internal procedures and variables.
+    The Tcl namespace ::dejagnu and all child namespaces are entirely
+    internal and should not be mentioned in testsuite code.  Its contents
+    are subject to change without notice, even on point releases.
 
 Changes since 1.6.1:
 
diff --git a/doc/dejagnu.texi b/doc/dejagnu.texi
index bb386e8..cafb531 100644
--- a/doc/dejagnu.texi
+++ b/doc/dejagnu.texi
@@ -3234,6 +3234,21 @@ 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.
 
+@subsubheading testsuite can call api
+
+The @code{testsuite can call api} command is a feature test and
+returns a boolean value indicating if a subcommand under a multiplex
+point is available.  This API call is needed because only the
+multiplex points themselves are visible to the Tcl info command.
+
+@quotation
+@t{  @b{testsuite can call api} @i{feature}... }
+@end quotation
+
+Any number of words are joined together into a single name, beginning
+with a multiplex entry point and forming the full name of an API call
+as documented in this manual.
+
 @node Procedures For Remote Communication, connprocs, Core Internal Procedures, Built-in Procedures
 @section Procedures For Remote Communication
 
@@ -5839,4 +5854,5 @@ This makes @code{runtest} exit.  Abbreviation: @kbd{q}.
 
 @c  LocalWords:  subdirectory prepend prepended testsuite filename Expect's svn
 @c  LocalWords:  DejaGnu CVS RCS SCCS prepending subcommands Tcl Awk Readline
-@c  LocalWords:  POSIX KFAIL KPASS XFAIL XPASS hostname multitable gfortran
+@c  LocalWords:  POSIX KFAIL KPASS XFAIL XPASS hostname multitable gfortran api
+@c  LocalWords:  boolean subcommand
diff --git a/lib/framework.exp b/lib/framework.exp
index e6ce197..e0f2ee6 100644
--- a/lib/framework.exp
+++ b/lib/framework.exp
@@ -1019,10 +1019,30 @@ proc incr_count { name args } {
 proc testsuite { subcommand args } {
     if { $subcommand eq "file" } {
 	testsuite_file $args
+    } elseif { $subcommand eq "can" } {
+	testsuite_can $args
     } else {
 	error "unknown \"testsuite\" command: testsuite $subcommand $args"
     }
 }
+namespace eval ::dejagnu {}
+
+# Feature test
+#
+proc testsuite_can { argv } {
+    verbose "entering testsuite can $argv" 3
+
+    if { [lrange $argv 0 1] eq "call api" } {
+	set call [lrange $argv 2 end]
+	set result [info exists ::dejagnu::apilist($call)]
+    } else {
+	error "unknown feature test:  testsuite can $argv"
+    }
+
+    verbose "leaving testsuite can: $result" 3
+    return $result
+}
+array set ::dejagnu::apilist { {testsuite can call api} 1 }
 
 # Return a full file name in or near the testsuite
 #
@@ -1075,3 +1095,4 @@ proc testsuite_file { argv } {
     verbose "leaving testsuite file: $result" 3
     return $result
 }
+array set ::dejagnu::apilist { {testsuite file} 1 }
diff --git a/testsuite/runtest.libs/testsuite_can.test b/testsuite/runtest.libs/testsuite_can.test
new file mode 100644
index 0000000..98d4e38
--- /dev/null
+++ b/testsuite/runtest.libs/testsuite_can.test
@@ -0,0 +1,29 @@
+# test "testsuite can" API call					-*- Tcl -*-
+
+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"
+}
+
+# API availability check tests
+
+run_tests {
+    { lib_errpat_test testsuite { can }
+	"*unknown feature test*"
+	"testsuite can without arguments" }
+    { lib_errpat_test testsuite { can call }
+	"*unknown feature test*"
+	"testsuite can call without 'api'" }
+    { lib_bool_test testsuite { can call api } false
+	"testsuite can call api returns false for null API call name" }
+    { lib_bool_test testsuite { can call api testsuite can call api } true
+	"testsuite can call api reports its own existence" }
+}
+
+puts "END testsuite_can.test"