--- /dev/null
+# Copyright 2020 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+# This library provides some protection against the introduction of
+# tests that include either the source of build paths in the test
+# name. When a test includes the path in its test name it is harder
+# to compare results between two runs of GDB from different trees.
+
+namespace eval ::CheckTestNames {
+ # An associative array of counts of tests that include a path in their
+ # test name. There are two counts, 'count', which counts occurrences
+ # within a single variant run, and 'total', which counts across all
+ # variants.
+ variable counts
+ array set counts {}
+ foreach nm {paths} {
+ set counts($nm,count) 0
+ set counts($nm,total) 0
+ }
+
+ # Increment the count, and total count for TYPE.
+ proc inc_count { type } {
+ variable counts
+
+ incr counts($type,count)
+ incr counts($type,total)
+ }
+
+ # Check if MESSAGE contains a build or source path, if it does increment
+ # the relevant counter and return true, otherwise, return false.
+ proc _check_paths { message } {
+ global srcdir objdir
+
+ foreach path [list $srcdir $objdir] {
+ if { [ string first $path $message ] >= 0 } {
+ # Count each test just once.
+ inc_count paths
+ return true
+ }
+ }
+
+ return false
+ }
+
+ # Remove the leading Dejagnu status marker from MESSAGE, and
+ # return the remainder of MESSAGE. A status marker is something
+ # like 'PASS: '. It is assumed that MESSAGE does contain such a
+ # marker. If it doesn't then MESSAGE is returned unmodified.
+ proc _strip_status { message } {
+ # Find the position of the first ': ' string.
+ set pos [string first ": " $message]
+ if { $pos > -1 } {
+ # The '+ 2' is so we skip the ': ' we found above.
+ return [string range $message [expr $pos + 2] end]
+ }
+
+ return $message
+ }
+
+ # Check if MESSAGE contains either the source path or the build path.
+ # This will result in test names that can't easily be compared between
+ # different runs of GDB.
+ #
+ # Any offending test names cause the corresponding count to be
+ # incremented, and an extra message to be printed into the log
+ # file.
+ proc check { message } {
+ set message [ _strip_status $message ]
+
+ if [ _check_paths $message ] {
+ clone_output "PATH: $message"
+ }
+ }
+
+ # If COUNT is greater than zero, disply PREFIX followed by COUNT.
+ proc maybe_show_count { prefix count } {
+ if { $count > 0 } {
+ clone_output "$prefix$count"
+ }
+ }
+
+ # Rename Dejagnu's log_summary procedure, and create do_log_summary to
+ # replace it. We arrange to have do_log_summary called later.
+ rename ::log_summary log_summary
+ proc do_log_summary { args } {
+ variable counts
+
+ # If ARGS is the empty list then we don't want to pass a single
+ # empty string as a parameter here.
+ eval "CheckTestNames::log_summary $args"
+
+ if { [llength $args] == 0 } {
+ set which "count"
+ } else {
+ set which [lindex $args 0]
+ }
+
+ maybe_show_count "# of paths in test names\t" \
+ $counts(paths,$which)
+ }
+
+ # Rename Dejagnu's reset_vars procedure, and create do_reset_vars to
+ # replace it. We arrange to have do_reset_vars called later.
+ rename ::reset_vars reset_vars
+ proc do_reset_vars {} {
+ variable counts
+
+ CheckTestNames::reset_vars
+
+ foreach nm {paths} {
+ set counts($nm,count) 0
+ }
+ }
+}
+
+# Arrange for Dejagnu to call CheckTestNames::check for each test result.
+foreach nm {pass fail xfail kfail xpass kpass unresolved untested \
+ unsupported} {
+ set local_record_procs($nm) "CheckTestNames::check"
+}
+
+# Create new global log_summary to replace Dejagnu's.
+proc log_summary { args } {
+ eval "CheckTestNames::do_log_summary $args"
+}
+
+# Create new global reset_vars to replace Dejagnu's.
+proc reset_vars {} {
+ eval "CheckTestNames::do_reset_vars"
+}
projects / binutils-gdb.git / commitdiff