Patchwork [testsuite] access name from dg-test via a proc instead of upvar

login
register
mail settings
Submitter Janis Johnson
Date June 26, 2012, 1:42 a.m.
Message ID <4FE91395.5020404@mentor.com>
Download mbox | patch
Permalink /patch/167287/
State New
Headers show

Comments

Janis Johnson - June 26, 2012, 1:42 a.m.
Lots of places in GCC's testsuite infrastructure get the test name with
current torture options, set up by DejaGnu's dg-test, by using upvar.
These accesses usually have a comment that this is ugly but there's
nothing else to do.  I recently modified that test name for use by the
scan directives to add an extra space, not realizing that I was changing
the actual variable from dg-test, so tests that use a lot of scans are
getting one more space per scan message.  Checking for options in the
name and adding a space also slowed things down quite a bit.

This patch limits the use of upvar for "name" in dg-test to a new proc
which saves its value for further uses in the same test, with an extra
space at the end if there are torture options.

Tested on i686-pc-linux-gnu for gcc and g++.  OK for trunk?

Janis
2012-06-25  Janis Johnson  <janisjo@codesourcery.com>

	* lib/target-supports-dg.exp (testname-for-summary): New.
	* lib/profopt.exp (profopt_execute): Define testname_with_flags.
	* lib/gcc-dg.exp (cleanup-coverage-files, cleanup-repo-notes,
	cleanup-stack-usage, cleanup-dump, cleanup-saved-temps, scan-module,
	scan-module-absence, output-exists, output-exists-not: Use
	testname-for-summary.
	(dg-test): Clean up testname_with_flags.
	* lib/scanasm.exp (scan-assembler, scan-assembler-not, scan-hidden,
	scan-not-hidden, scan-file, scan-file-not, scan-stack-usage,
	scan-stack-usage-not, scan-assembler-times, scan-assembler-dem,
	scan-assembler-dem-not, object-size: Use testname-for-summary.
	* lib/gcov.exp (run-gcov): Likewise.
	* lib/scandump.exp (scan-dump, scan-dump-times, scan-dump-not,
	scan-dump-dem, scan-dump-dem-note): Likewise.
Mike Stump - June 26, 2012, 2:19 a.m.
On Jun 25, 2012, at 6:42 PM, Janis Johnson wrote:
> Lots of places in GCC's testsuite infrastructure get the test name with
> current torture options, set up by DejaGnu's dg-test, by using upvar.
> These accesses usually have a comment that this is ugly but there's
> nothing else to do.

> OK for trunk?

Ok.

Patch

Index: lib/target-supports-dg.exp
===================================================================
--- lib/target-supports-dg.exp	(revision 188964)
+++ lib/target-supports-dg.exp	(working copy)
@@ -31,6 +31,34 @@ 
     return "$flags1 $flags2"
 }
 
+# DejaGnu's dg-test defines a test name that includes torture options
+# which is used in most pass/fail messages.  Grab a copy of it.
+
+proc testname-for-summary { } {
+    global testname_with_flags
+
+    # A variable called "name" is too generic, so identify dg-test by
+    # the existence of dg-extra-tool-flags.
+    if ![info exists testname_with_flags] {
+	set frames 2
+	while { ![info exists flags] } {
+	    set frames [expr $frames + 1]
+	    upvar $frames dg-extra-tool-flags flags
+	}
+
+	# We've got the stack level for dg-test; get the variable we want.
+	upvar $frames name name
+	set testname_with_flags $name
+
+	# If there are flags, add an extra space to improve readability of
+	# the test summary.
+	if { [llength $testname_with_flags] > 1 } {
+	    set testname_with_flags "$testname_with_flags "
+	}
+    }
+    return "$testname_with_flags"
+}
+
 # If this target does not support weak symbols, skip this test.
 
 proc dg-require-weak { args } {
Index: lib/profopt.exp
===================================================================
--- lib/profopt.exp	(revision 188964)
+++ lib/profopt.exp	(working copy)
@@ -217,6 +217,7 @@ 
     global tool profile_option feedback_option prof_ext perf_ext perf_delta
     global generate_final_code use_final_code
     global verbose
+    global testname_with_flags
 
     if ![info exists profile_option] {
         error "No profile option specified for first compile."
@@ -240,6 +241,12 @@ 
 	set testcase "[file tail [file dirname $src]]/[file tail $src]"
     }
 
+    # Several procedures access the name of the test with torture flags,
+    # normally defined in dg-test.  Profile optimization tests don't
+    # use dg-test, so define it here to make it accessible via
+    # testname-for-summary.
+    set testname_with_flags $testcase
+
     set executable $tmpdir/[file tail [file rootname $src].x]
     set basename [file tail $testcase]
     set base [file rootname $basename]
@@ -272,6 +279,7 @@ 
 	set extra_flags [profopt-get-options $src]
 	if { [lindex ${dg-do-what} 1 ] == "N" } {
 	    unsupported "$src"
+	    unset testname_with_flags
 	    verbose "$src not supported on this target, skipping it" 3
 	    return
 	}
@@ -437,4 +445,5 @@ 
 	    remote_file build delete $execname3
 	}
     }
+    unset testname_with_flags
 }
Index: lib/gcc-dg.exp
===================================================================
--- lib/gcc-dg.exp	(revision 188964)
+++ lib/gcc-dg.exp	(working copy)
@@ -433,10 +433,7 @@ 
 
 # Remove compiler-generated coverage files for the current test.
 proc cleanup-coverage-files { } {
-    # This assumes that we are two frames down from dg-test or some other proc
-    # that stores the filename of the testcase in a local variable "name".
-    # A cleaner solution would require a new DejaGnu release.
-    upvar 2 name testcase
+    set testcase [testname-for-summary]
     # The name might include a list of options; extract the file name.
     set testcase [lindex $testcase 0]
     remove-build-file "[file rootname [file tail $testcase]].gc??"
@@ -451,10 +448,7 @@ 
 
 # Remove compiler-generated files from -repo for the current test.
 proc cleanup-repo-files { } {
-    # This assumes that we are two frames down from dg-test or some other proc
-    # that stores the filename of the testcase in a local variable "name".
-    # A cleaner solution would require a new DejaGnu release.
-    upvar 2 name testcase
+    set testcase [testname-for-summary]
     # The name might include a list of options; extract the file name.
     set testcase [lindex $testcase 0]
     remove-build-file "[file rootname [file tail $testcase]].o"
@@ -492,10 +486,7 @@ 
 
 # Remove a stack usage file for the current test.
 proc cleanup-stack-usage { } {
-    # This assumes that we are two frames down from dg-test or some other proc
-    # that stores the filename of the testcase in a local variable "name".
-    # A cleaner solution would require a new DejaGnu release.
-    upvar 2 name testcase
+    set testcase [testname-for-summary]
     # The name might include a list of options; extract the file name.
     set testcase [lindex $testcase 0]
     remove-build-file "[file rootname [file tail $testcase]].su"
@@ -510,10 +501,7 @@ 
 
 # Remove all dump files with the provided suffix.
 proc cleanup-dump { suffix } {
-    # This assumes that we are three frames down from dg-test or some other
-    # proc that stores the filename of the testcase in a local variable
-    # "name".  A cleaner solution would require a new DejaGnu release.
-    upvar 3 name testcase
+    set testcase [testname-for-summary]
     # The name might include a list of options; extract the file name.
     set src [file tail [lindex $testcase 0]]
     remove-build-file "[file tail $src].$suffix"
@@ -550,10 +538,7 @@ 
 	}
     }
 
-    # This assumes that we are two frames down from dg-test or some other proc
-    # that stores the filename of the testcase in a local variable "name".
-    # A cleaner solution would require a new DejaGnu release.
-    upvar 2 name testcase
+    set testcase [testname-for-summary]
     # The name might include a list of options; extract the file name.
     set testcase [lindex $testcase 0]
     foreach suffix $suffixes {
@@ -584,7 +569,7 @@ 
     set text [read $fd]
     close $fd
 
-    upvar 2 name testcase
+    set testcase [testname-for-summary]
     if [regexp -- [lindex $args 1] $text] {
       pass "$testcase scan-module [lindex $args 1]"
     } else {
@@ -602,7 +587,7 @@ 
     set text [read $fd]
     close $fd
 
-    upvar 2 name testcase
+    set testcase [testname-for-summary]
     if [regexp -- [lindex $args 1] $text] {
       fail "$testcase scan-module [lindex $args 1]"
     } else {
@@ -622,8 +607,8 @@ 
 	}
     }
 
-    # Access variables from gcc-dg-test-1.
-    upvar 2 name testcase
+    set testcase [testname-for-summary]
+    # Access variable from gcc-dg-test-1.
     upvar 2 output_file output_file
 
     if [file exists $output_file] {
@@ -645,8 +630,8 @@ 
 	}
     }
 
-    # Access variables from gcc-dg-test-1.
-    upvar 2 name testcase
+    set testcase [testname-for-summary]
+    # Access variable from gcc-dg-test-1.
     upvar 2 output_file output_file
 
     if [file exists $output_file] {
@@ -674,6 +659,7 @@ 
 	global errorInfo
 	global compiler_conditional_xfail_data
 	global shouldfail
+	global testname_with_flags
 
 	if { [ catch { eval saved-dg-test $args } errmsg ] } {
 	    set saved_info $errorInfo
@@ -684,6 +670,9 @@ 
 	    if [info exists compiler_conditional_xfail_data] {
 		unset compiler_conditional_xfail_data
 	    }
+	    if [info exists testname_with_flags] {
+		unset testname_with_flags
+	    }
 	    unset_timeout_vars
 	    error $errmsg $saved_info
 	}
@@ -695,6 +684,9 @@ 
 	if [info exists compiler_conditional_xfail_data] {
 	    unset compiler_conditional_xfail_data
 	}
+	if [info exists testname_with_flags] {
+	    unset testname_with_flags
+	}
     }
 }
 
Index: lib/scanasm.exp
===================================================================
--- lib/scanasm.exp	(revision 188964)
+++ lib/scanasm.exp	(working copy)
@@ -78,10 +78,7 @@ 
 # dg-scan for details.
 
 proc scan-assembler { args } {
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
+    set testcase [testname-for-summary]
     set output_file "[file rootname [file tail $testcase]].s"
     dg-scan "scan-assembler" 1 $testcase $output_file $args
 }
@@ -95,10 +92,7 @@ 
 # compiler.  See dg-scan for details.
 
 proc scan-assembler-not { args } {
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
+    set testcase [testname-for-summary]
     set output_file "[file rootname [file tail $testcase]].s"
 
     dg-scan "scan-assembler-not" 0 $testcase $output_file $args
@@ -128,10 +122,7 @@ 
 # produced by the compiler.
 
 proc scan-hidden { args } {
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
+    set testcase [testname-for-summary]
     set output_file "[file rootname [file tail $testcase]].s"
 
     set symbol [lindex $args 0]
@@ -147,10 +138,7 @@ 
 # produced by the compiler.
 
 proc scan-not-hidden { args } {
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
+    set testcase [testname-for-summary]
     set output_file "[file rootname [file tail $testcase]].s"
 
     set symbol [lindex $args 0]
@@ -164,10 +152,7 @@ 
 # Look for a pattern in OUTPUT_FILE.  See dg-scan for details.
 
 proc scan-file { output_file args } {
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
+    set testcase [testname-for-summary]
     dg-scan "scan-file" 1 $testcase $output_file $args
 }
 
@@ -175,10 +160,7 @@ 
 # for details.
 
 proc scan-file-not { output_file args } {
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
+    set testcase [testname-for-summary]
     dg-scan "scan-file-not" 0 $testcase $output_file $args
 }
 
@@ -186,10 +168,7 @@ 
 # dg-scan for details.
 
 proc scan-stack-usage { args } {
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
+    set testcase [testname-for-summary]
     set output_file "[file rootname [file tail $testcase]].su"
 
     dg-scan "scan-file" 1 $testcase $output_file $args
@@ -199,10 +178,7 @@ 
 # compiler.  See dg-scan for details.
 
 proc scan-stack-usage-not { args } {
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
+    set testcase [testname-for-summary]
     set output_file "[file rootname [file tail $testcase]].su"
 
     dg-scan "scan-file-not" 0 $testcase $output_file $args
@@ -227,14 +203,7 @@ 
 	}
     }
 
-    # This assumes that we are two frames down from dg-test, and that
-    # it still stores the filename of the testcase in a local variable "name".
-    # A cleaner solution would require a new dejagnu release.
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
-
+    set testcase [testname-for-summary]
     set pattern [lindex $args 0]
     set pp_pattern [make_pattern_printable $pattern]
 
@@ -292,10 +261,7 @@ 
 	verbose -log "c++filt is $cxxfilt"
     }
 
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
+    set testcase [testname-for-summary]
     set pattern [lindex $args 0]
     set pp_pattern [make_pattern_printable $pattern]
     set output_file "[file rootname [file tail $testcase]].s"
@@ -349,10 +315,7 @@ 
 	verbose -log "c++filt is $cxxfilt"
     }
 
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
+    set testcase [testname-for-summary]
     set pattern [lindex $args 0]
     set pp_pattern [make_pattern_printable $pattern]
     set output_file "[file rootname [file tail $testcase]].s"
@@ -407,11 +370,7 @@ 
 	verbose -log "size is $size"
     }
 
-    upvar 2 name testcase
-    if { [llength $testcase] > 1 } {
-	set testcase "$testcase "
-    }
-
+    set testcase [testname-for-summary]
     set what [lindex $args 0]
     set where [lsearch { text data bss total } $what]
     if { $where == -1 } {
Index: lib/gcov.exp
===================================================================
--- lib/gcov.exp	(revision 188964)
+++ lib/gcov.exp	(working copy)
@@ -265,8 +265,7 @@ 
 	}
     }
 
-    # Get the test name, including options that make it unique, from gnu-test 2 levels up.
-    upvar 2 name testname
+    set testname [testname-for-summary]
 
     # Extract the test file name from the arguments.
     set testcase [lindex $gcov_args end]
Index: lib/scandump.exp
===================================================================
--- lib/scandump.exp	(revision 188964)
+++ lib/scandump.exp	(working copy)
@@ -45,10 +45,7 @@ 
         }
     }
 
-    # This assumes that we are three frames down from dg-test, and that
-    # it still stores the filename of the testcase in a local variable "name".
-    # A cleaner solution would require a new DejaGnu release.
-    upvar 3 name testcase
+    set testcase [testname-for-summary]
 
     set suf [dump-suffix [lindex $args 2]]
     set testname "$testcase scan-[lindex $args 0]-dump $suf \"[lindex $args 1]\""
@@ -88,11 +85,7 @@ 
 	}
     }
 
-    # This assumes that we are three frames down from dg-test, and that
-    # it still stores the filename of the testcase in a local variable "name".
-    # A cleaner solution would require a new DejaGnu release.
-    upvar 3 name testcase
-
+    set testcase [testname-for-summary]
     set suf [dump-suffix [lindex $args 3]]
     set printable_pattern [make_pattern_printable [lindex $args 1]]
     set testname "$testcase scan-[lindex $args 0]-dump-times $suf \"$printable_pattern\" [lindex $args 2]"
@@ -132,11 +125,7 @@ 
 	}
     }
 
-    # This assumes that we are three frames down from dg-test, and that
-    # it still stores the filename of the testcase in a local variable "name".
-    # A cleaner solution would require a new DejaGnu release.
-    upvar 3 name testcase
-
+    set testcase [testname-for-summary]
     set suf [dump-suffix [lindex $args 2]]
     set testname "$testcase scan-[lindex $args 0]-dump-not $suf \"[lindex $args 1]\""
     set src [file tail [lindex $testcase 0]]
@@ -188,7 +177,7 @@ 
 	verbose -log "c++filt is $cxxfilt"
     }
 
-    upvar 3 name testcase
+    set testcase [testname-for-summary]
     set suf [dump-suffix [lindex $args 2]]
     set testname "$testcase scan-[lindex $args 0]-dump-dem $suf \"[lindex $args 1]\""
     set src [file tail [lindex $testcase 0]]
@@ -239,8 +228,7 @@ 
 	verbose -log "c++filt is $cxxfilt"
     }
 
-    upvar 3 name testcase
-
+    set testcase [testname-for-summary]
     set suf [dump-suffix [lindex $args 2]]
     set testname "$testcase scan-[lindex $args 0]-dump-dem-not $suf \"[lindex $args 1]\""
     set src [file tail [lindex $testcase 0]]