[PATCH 2/2] Testsuite: Add gdb_simple_compile

[PATCH 2/2] Testsuite: Add gdb_simple_compile

[Alan Hayward]

Simplfy gdb.exp by adding a function that will attempt to
compile a piece of code, then clean up, leaving the created
object.

gdb/testsuite

2018-09-06  Alan Hayward  <alan.hayward@arm.com>

        * lib/gdb.exp (gdb_simple_compile): Add proc.
        (is_elf_target): Use gdb_simple_compile.
        (skip_altivec_tests): Likewise.
        (skip_vsx_tests): Likewise.
        (skip_tsx_tests): Likewise.
        (skip_btrace_tests): Likewise.
        (skip_btrace_pt_tests): Likewise.
        (gdb_can_simple_compile): Likewise.
        (gdb_has_argv0): Likewise.
        (gdb_target_symbol_prefix): Likewise.
        (target_supports_scheduler_locking): Likewise.
---
 gdb/testsuite/lib/gdb.exp | 253 +++++++++++++++-------------------------------
 1 file changed, 84 insertions(+), 169 deletions(-)

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 43c9b03d01..c7efcecae8 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -2376,21 +2376,10 @@ proc readline_is_used { } {
 gdb_caching_proc is_elf_target {
     set me "is_elf_target"
 
-    set src [standard_temp_file is_elf_target[pid].c]
-    set obj [standard_temp_file is_elf_target[pid].o]
-
-    gdb_produce_source $src {
-	int foo () {return 0;}
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-
-    file delete $src
-
-    if ![string match "" $lines] then {
-	verbose "$me:  testfile compilation failed, returning 0" 2
-	return 0
+    global obj
+    set src { int foo () {return 0;} }
+    if {![gdb_simple_compile elf_target $src]} {
+        return 0
     }
 
     set fp_obj [open $obj "r"]
@@ -2554,27 +2543,22 @@ gdb_caching_proc skip_altivec_tests {
     }
 
     # Make sure we have a compiler that understands altivec.
-    set compile_flags {debug nowarnings}
     if [get_compiler_info] {
        warning "Could not get compiler info"
        return 1
     }
     if [test_compiler_info gcc*] {
-        set compile_flags "$compile_flags additional_flags=-maltivec"
+        set compile_flags "{additional_flags=-maltivec}"
     } elseif [test_compiler_info xlc*] {
-        set compile_flags "$compile_flags additional_flags=-qaltivec"
+        set compile_flags "{additional_flags=-qaltivec}"
     } else {
         verbose "Could not compile with altivec support, returning 1" 2
         return 1
     }
 
-    # Set up, compile, and execute a test program containing VMX instructions.
-    # Include the current process ID in the file names to prevent conflicts
-    # with invocations for multiple testsuites.
-    set src [standard_temp_file vmx[pid].c]
-    set exe [standard_temp_file vmx[pid].x]
-
-    gdb_produce_source $src {
+    # Compile a test program containing VMX instructions.
+    global obj
+    set src {
 	int main() {
 	    #ifdef __MACH__
 	    asm volatile ("vor v0,v0,v0");
@@ -2584,22 +2568,16 @@ gdb_caching_proc skip_altivec_tests {
 	    return 0;
 	}
     }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $exe executable $compile_flags]
-    file delete $src
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 1" 2
+    if {![gdb_simple_compile $me $src executable $compile_flags]} {
         return 1
     }
 
-    # No error message, compilation succeeded so now run it via gdb.
+    # Compilation succeeded so now run it via gdb.
 
     gdb_exit
     gdb_start
     gdb_reinitialize_dir $srcdir/$subdir
-    gdb_load "$exe"
+    gdb_load "$obj"
     gdb_run_cmd
     gdb_expect {
         -re ".*Illegal instruction.*${gdb_prompt} $" {
@@ -2616,7 +2594,7 @@ gdb_caching_proc skip_altivec_tests {
         }
     }
     gdb_exit
-    remote_file build delete $exe
+    remote_file build delete $obj
 
     verbose "$me:  returning $skip_vmx_tests" 2
     return $skip_vmx_tests
@@ -2638,24 +2616,22 @@ gdb_caching_proc skip_vsx_tests {
     }
 
     # Make sure we have a compiler that understands altivec.
-    set compile_flags {debug nowarnings quiet}
     if [get_compiler_info] {
        warning "Could not get compiler info"
        return 1
     }
     if [test_compiler_info gcc*] {
-        set compile_flags "$compile_flags additional_flags=-mvsx"
+        set compile_flags "{additional_flags=-mvsx}"
     } elseif [test_compiler_info xlc*] {
-        set compile_flags "$compile_flags additional_flags=-qasm=gcc"
+        set compile_flags "{additional_flags=-qasm=gcc}"
     } else {
         verbose "Could not compile with vsx support, returning 1" 2
         return 1
     }
 
-    set src [standard_temp_file vsx[pid].c]
-    set exe [standard_temp_file vsx[pid].x]
-
-    gdb_produce_source $src {
+    # Compile a test program containing VSX instructions.
+    global obj
+    set src {
 	int main() {
 	    double a[2] = { 1.0, 2.0 };
 	    #ifdef __MACH__
@@ -2666,13 +2642,7 @@ gdb_caching_proc skip_vsx_tests {
 	    return 0;
 	}
     }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $exe executable $compile_flags]
-    file delete $src
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 1" 2
+    if {![gdb_simple_compile $me $src executable $compile_flags]} {
         return 1
     }
 
@@ -2681,7 +2651,7 @@ gdb_caching_proc skip_vsx_tests {
     gdb_exit
     gdb_start
     gdb_reinitialize_dir $srcdir/$subdir
-    gdb_load "$exe"
+    gdb_load "$obj"
     gdb_run_cmd
     gdb_expect {
         -re ".*Illegal instruction.*${gdb_prompt} $" {
@@ -2698,7 +2668,7 @@ gdb_caching_proc skip_vsx_tests {
         }
     }
     gdb_exit
-    remote_file build delete $exe
+    remote_file build delete $obj
 
     verbose "$me:  returning $skip_vsx_tests" 2
     return $skip_vsx_tests
@@ -2712,24 +2682,17 @@ gdb_caching_proc skip_tsx_tests {
 
     set me "skip_tsx_tests"
 
-    set src [standard_temp_file tsx[pid].c]
-    set exe [standard_temp_file tsx[pid].x]
-
-    gdb_produce_source $src {
-    int main() {
-        asm volatile ("xbegin .L0");
-        asm volatile ("xend");
-        asm volatile (".L0: nop");
-        return 0;
-    }
+    # Compile a test program.
+    global obj
+    set src {
+        int main() {
+            asm volatile ("xbegin .L0");
+            asm volatile ("xend");
+            asm volatile (".L0: nop");
+            return 0;
+        }
     }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $exe executable {nowarnings quiet}]
-    file delete $src
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed." 2
+    if {![gdb_simple_compile $me $src executable]} {
         return 1
     }
 
@@ -2738,7 +2701,7 @@ gdb_caching_proc skip_tsx_tests {
     gdb_exit
     gdb_start
     gdb_reinitialize_dir $srcdir/$subdir
-    gdb_load "$exe"
+    gdb_load "$obj"
     gdb_run_cmd
     gdb_expect {
         -re ".*Illegal instruction.*${gdb_prompt} $" {
@@ -2755,7 +2718,7 @@ gdb_caching_proc skip_tsx_tests {
         }
     }
     gdb_exit
-    remote_file build delete $exe
+    remote_file build delete $obj
 
     verbose "$me:  returning $skip_tsx_tests" 2
     return $skip_tsx_tests
@@ -2773,24 +2736,11 @@ gdb_caching_proc skip_btrace_tests {
         return 1
     }
 
-    # Set up, compile, and execute a test program.
-    # Include the current process ID in the file names to prevent conflicts
-    # with invocations for multiple testsuites.
-    set src [standard_temp_file btrace[pid].c]
-    set exe [standard_temp_file btrace[pid].x]
-
-    gdb_produce_source $src {
-	int main(void) { return 0; }
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set compile_flags {debug nowarnings quiet}
-    set lines [gdb_compile $src $exe executable $compile_flags]
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 1" 2
-	file delete $src
-        return 1
+    # Compile a test program.
+    global obj
+    set src { int main() { return 0; } }
+    if {![gdb_simple_compile $me $src executable]} {
+        return 0
     }
 
     # No error message, compilation succeeded so now run it via gdb.
@@ -2798,12 +2748,10 @@ gdb_caching_proc skip_btrace_tests {
     gdb_exit
     gdb_start
     gdb_reinitialize_dir $srcdir/$subdir
-    gdb_load $exe
+    gdb_load $obj
     if ![runto_main] {
-	file delete $src
         return 1
     }
-    file delete $src
     # In case of an unexpected output, we return 2 as a fail value.
     set skip_btrace_tests 2
     gdb_test_multiple "record btrace" "check btrace support" {
@@ -2821,7 +2769,7 @@ gdb_caching_proc skip_btrace_tests {
         }
     }
     gdb_exit
-    remote_file build delete $exe
+    remote_file build delete $obj
 
     verbose "$me:  returning $skip_btrace_tests" 2
     return $skip_btrace_tests
@@ -2840,24 +2788,11 @@ gdb_caching_proc skip_btrace_pt_tests {
         return 1
     }
 
-    # Set up, compile, and execute a test program.
-    # Include the current process ID in the file names to prevent conflicts
-    # with invocations for multiple testsuites.
-    set src [standard_temp_file btrace[pid].c]
-    set exe [standard_temp_file btrace[pid].x]
-
-    gdb_produce_source $src {
-	int main(void) { return 0; }
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set compile_flags {debug nowarnings quiet}
-    set lines [gdb_compile $src $exe executable $compile_flags]
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 1" 2
-	file delete $src
-        return 1
+    # Compile a test program.
+    global obj
+    set src { int main() { return 0; } }
+    if {![gdb_simple_compile $me $src executable]} {
+        return 0
     }
 
     # No error message, compilation succeeded so now run it via gdb.
@@ -2865,12 +2800,10 @@ gdb_caching_proc skip_btrace_pt_tests {
     gdb_exit
     gdb_start
     gdb_reinitialize_dir $srcdir/$subdir
-    gdb_load $exe
+    gdb_load $obj
     if ![runto_main] {
-	file delete $src
         return 1
     }
-    file delete $src
     # In case of an unexpected output, we return 2 as a fail value.
     set skip_btrace_tests 2
     gdb_test_multiple "record btrace pt" "check btrace pt support" {
@@ -2891,7 +2824,7 @@ gdb_caching_proc skip_btrace_pt_tests {
         }
     }
     gdb_exit
-    remote_file build delete $exe
+    remote_file build delete $obj
 
     verbose "$me:  returning $skip_btrace_tests" 2
     return $skip_btrace_tests
@@ -3407,9 +3340,10 @@ gdb_caching_proc universal_compile_options {
 
 # Compile the code in $code to a file based on $name.
 # Return 1 if code can be compiled
-# Delete all created files and objects.
+# Leave the file name of the resulting object in the global $obj.
 
-proc gdb_can_simple_compile {name code {type object} {compile_flags {}}} {
+proc gdb_simple_compile {name code {type object} {compile_flags {}}} {
+    global obj
 
     switch -regexp -- $type {
         "executable" {
@@ -3435,7 +3369,6 @@ proc gdb_can_simple_compile {name code {type object} {compile_flags {}}} {
     set lines [gdb_compile $src $obj $type $compile_flags]
 
     file delete $src
-    file delete $obj
 
     if ![string match "" $lines] then {
         verbose "$name:  compilation failed, returning 0" 2
@@ -3444,6 +3377,17 @@ proc gdb_can_simple_compile {name code {type object} {compile_flags {}}} {
     return 1
 }
 
+# Compile the code in $code to an object.
+# Return 1 if code can be compiled.
+# Delete all created files and objects.
+
+proc gdb_can_simple_compile {name code {type object} {compile_flags ""}} {
+    global obj
+    set ret [gdb_simple_compile $name $code $type $compile_flags]
+    file delete $obj
+    return $ret
+}
+
 # Some targets need to always link a special object in.  Save its path here.
 global gdb_saved_set_unbuffered_mode_obj
 set gdb_saved_set_unbuffered_mode_obj ""
@@ -5145,18 +5089,15 @@ gdb_caching_proc gdb_skip_xml_test {
 gdb_caching_proc gdb_has_argv0 {
     set result 0
 
-    # Set up, compile, and execute a test program to check whether
-    # argv[0] is available.
-    set src [standard_temp_file has_argv0[pid].c]
-    set exe [standard_temp_file has_argv0[pid].x]
+    # Compile and execute a test program to check whether argv[0] is available.
 
-    gdb_produce_source $src {
+    global obj
+    gdb_simple_compile has_argv0 {
 	int main (int argc, char **argv) {
 	    return 0;
 	}
-    }
+    } executable
 
-    gdb_compile $src $exe executable {debug}
 
     # Helper proc.
     proc gdb_has_argv0_1 { exe } {
@@ -5227,11 +5168,10 @@ gdb_caching_proc gdb_has_argv0 {
 	return $retval
     }
 
-    set result [gdb_has_argv0_1 $exe]
+    set result [gdb_has_argv0_1 $obj]
 
     gdb_exit
-    file delete $src
-    file delete $exe
+    file delete $obj
 
     if { !$result
       && ([istarget *-*-linux*]
@@ -5938,37 +5878,25 @@ proc core_find {binfile {deletefiles {}} {arg ""}} {
 # for linker symbol prefixes.
 
 gdb_caching_proc gdb_target_symbol_prefix {
-    # Set up and compile a simple test program...
-    set src [standard_temp_file main[pid].c]
-    set exe [standard_temp_file main[pid].x]
-
-    gdb_produce_source $src {
-	int main() {
-	    return 0;
-	}
+    # Compile a simple test program...
+    global obj
+    set src { int main() { return 0; } }
+    if {![gdb_simple_compile target_symbol_prefix $src executable]} {
+        return 0
     }
 
-    verbose "compiling testfile $src" 2
-    set compile_flags {debug nowarnings quiet}
-    set lines [gdb_compile $src $exe executable $compile_flags]
-
     set prefix ""
 
-    if ![string match "" $lines] then {
-        verbose "gdb_target_symbol_prefix: testfile compilation failed, returning null prefix" 2
-    } else {
-	set objdump_program [gdb_find_objdump]
-	set result [catch "exec $objdump_program --syms $exe" output]
+    set objdump_program [gdb_find_objdump]
+    set result [catch "exec $objdump_program --syms $obj" output]
 
-	if { $result == 0 \
-	     && ![regexp -lineanchor \
-	          { ([^ a-zA-Z0-9]*)main$} $output dummy prefix] } {
-	    verbose "gdb_target_symbol_prefix: Could not find main in objdump output; returning null prefix" 2
-	}
+    if { $result == 0 \
+	&& ![regexp -lineanchor \
+	     { ([^ a-zA-Z0-9]*)main$} $output dummy prefix] } {
+	verbose "gdb_target_symbol_prefix: Could not find main in objdump output; returning null prefix" 2
     }
 
-    file delete $src
-    file delete $exe
+    file delete $obj
 
     return $prefix
 }
@@ -5980,26 +5908,13 @@ gdb_caching_proc target_supports_scheduler_locking {
 
     set me "gdb_target_supports_scheduler_locking"
 
-    set src [standard_temp_file has_schedlock[pid].c]
-    set exe [standard_temp_file has_schedlock[pid].x]
-
-    gdb_produce_source $src {
-	int main () {
-	    return 0;
-	}
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set compile_flags {debug nowarnings}
-    set lines [gdb_compile $src $exe executable $compile_flags]
-    file delete $src
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 0" 2
+    global obj
+    set src { int main() { return 0; } }
+    if {![gdb_simple_compile $me $src executable]} {
         return 0
     }
 
-    clean_restart $exe
+    clean_restart $obj
     gdb_start_cmd
 
     set supports_schedule_locking -1
@@ -6038,7 +5953,7 @@ gdb_caching_proc target_supports_scheduler_locking {
     }
 
     gdb_exit
-    remote_file build delete $exe
+    remote_file build delete $obj
     verbose "$me:  returning $supports_schedule_locking" 2
     return $supports_schedule_locking
 }
-- 
2.15.2 (Apple Git-101.1)

[PATCH 1/2] Testsuite: Add gdb_can_simple_compile

[Alan Hayward]

Simplfy gdb.exp by adding a function that will attempt to
compile a piece of code, then clean up.

gdb/testsuite

2018-09-06  Alan Hayward  <alan.hayward@arm.com>

	* lib/gdb.exp (gdb_can_simple_compile): Add proc.
	(support_complex_tests): Use gdb_can_simple_compile.
	(is_ilp32_target): Likewise.
	(is_lp64_target): Likewise.
	(is_64_target): Likewise.
	(is_amd64_regs_target): Likewise.
	(is_aarch32_target): Likewise.
	(gdb_int128_helper): Likewise.
---
 gdb/testsuite/lib/gdb.exp | 184 +++++++++++++---------------------------------
 1 file changed, 52 insertions(+), 132 deletions(-)

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index dd2c57cbc2..43c9b03d01 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -2272,35 +2272,16 @@ gdb_caching_proc support_complex_tests {
 	return 0
     }
 
-    # Set up, compile, and execute a test program containing _Complex types.
-    # Include the current process ID in the file names to prevent conflicts
-    # with invocations for multiple testsuites.
-    set src [standard_temp_file complex[pid].c]
-    set exe [standard_temp_file complex[pid].x]
+    # Compile a test program containing _Complex types.
 
-    gdb_produce_source $src {
+    return [gdb_can_simple_compile complex {
 	int main() {
 	    _Complex float cf;
 	    _Complex double cd;
 	    _Complex long double cld;
 	    return 0;
 	}
-    }
-
-    verbose "compiling testfile $src" 2
-    set compile_flags {debug nowarnings quiet}
-    set lines [gdb_compile $src $exe executable $compile_flags]
-    file delete $src
-    file delete $exe
-
-    if ![string match "" $lines] then {
-        verbose "testfile compilation failed, returning 0" 2
-        set result 0
-    } else {
-	set result 1
-    }
-
-    return $result
+    } executable]
 }
 
 # Return 1 if GDB can get a type for siginfo from the target, otherwise
@@ -2462,86 +2443,32 @@ proc gdb_produce_source { name sources } {
 # This cannot be decided simply from looking at the target string,
 # as it might depend on externally passed compiler options like -m64.
 gdb_caching_proc is_ilp32_target {
-    set me "is_ilp32_target"
-
-    set src [standard_temp_file ilp32[pid].c]
-    set obj [standard_temp_file ilp32[pid].o]
-
-    gdb_produce_source $src {
+    return [gdb_can_simple_compile is_ilp32_target {
 	int dummy[sizeof (int) == 4
 		  && sizeof (void *) == 4
 		  && sizeof (long) == 4 ? 1 : -1];
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-    file delete $src
-    file delete $obj
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 0" 2
-        return 0
-    }
-
-    verbose "$me:  returning 1" 2
-    return 1
+    }]
 }
 
 # Return 1 if target is LP64.
 # This cannot be decided simply from looking at the target string,
 # as it might depend on externally passed compiler options like -m64.
 gdb_caching_proc is_lp64_target {
-    set me "is_lp64_target"
-
-    set src [standard_temp_file lp64[pid].c]
-    set obj [standard_temp_file lp64[pid].o]
-
-    gdb_produce_source $src {
+    return [gdb_can_simple_compile is_lp64_target {
 	int dummy[sizeof (int) == 4
 		  && sizeof (void *) == 8
 		  && sizeof (long) == 8 ? 1 : -1];
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-    file delete $src
-    file delete $obj
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 0" 2
-        return 0
-    }
-
-    verbose "$me:  returning 1" 2
-    return 1
+    }]
 }
 
 # Return 1 if target has 64 bit addresses.
 # This cannot be decided simply from looking at the target string,
 # as it might depend on externally passed compiler options like -m64.
 gdb_caching_proc is_64_target {
-    set me "is_64_target"
-
-    set src [standard_temp_file is64[pid].c]
-    set obj [standard_temp_file is64[pid].o]
-
-    gdb_produce_source $src {
+    return [gdb_can_simple_compile is_64_target {
 	int function(void) { return 3; }
 	int dummy[sizeof (&function) == 8 ? 1 : -1];
-    }
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-    file delete $src
-    file delete $obj
-
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 0" 2
-        return 0
-    }
-
-    verbose "$me:  returning 1" 2
-    return 1
+    }]
 }
 
 # Return 1 if target has x86_64 registers - either amd64 or x32.
@@ -2552,30 +2479,13 @@ gdb_caching_proc is_amd64_regs_target {
 	return 0
     }
 
-    set me "is_amd64_regs_target"
-
-    set src [standard_temp_file reg64[pid].s]
-    set obj [standard_temp_file reg64[pid].o]
-
     set list {}
     foreach reg \
 	{rax rbx rcx rdx rsi rdi rbp rsp r8 r9 r10 r11 r12 r13 r14 r15} {
 	    lappend list "\tincq %$reg"
 	}
-    gdb_produce_source $src [join $list \n]
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-    file delete $src
-    file delete $obj
 
-    if ![string match "" $lines] then {
-        verbose "$me:  testfile compilation failed, returning 0" 2
-        return 0
-    }
-
-    verbose "$me:  returning 1" 2
-    return 1
+    return [gdb_can_simple_compile is_amd64_regs_target [join $list \n]]
 }
 
 # Return 1 if this target is an x86 or x86-64 with -m32.
@@ -2597,30 +2507,13 @@ gdb_caching_proc is_aarch32_target {
 	return 0
     }
 
-    set me "is_aarch32_target"
-
-    set src [standard_temp_file aarch32[pid].s]
-    set obj [standard_temp_file aarch32[pid].o]
-
     set list {}
     foreach reg \
 	{r0 r1 r2 r3} {
 	    lappend list "\tmov $reg, $reg"
 	}
-    gdb_produce_source $src [join $list \n]
-
-    verbose "$me:  compiling testfile $src" 2
-    set lines [gdb_compile $src $obj object {quiet}]
-    file delete $src
-    file delete $obj
-
-    if ![string match "" $lines] then {
-	verbose "$me:  testfile compilation failed, returning 0" 2
-	return 0
-    }
 
-    verbose "$me:  returning 1" 2
-    return 1
+    return [gdb_can_simple_compile aarch32 [join $list \n]]
 }
 
 # Return 1 if this target is an aarch64, either lp64 or ilp32.
@@ -3006,22 +2899,10 @@ gdb_caching_proc skip_btrace_pt_tests {
 
 # A helper that compiles a test case to see if __int128 is supported.
 proc gdb_int128_helper {lang} {
-    set src [standard_temp_file i128[pid].c]
-    set obj [standard_temp_file i128[pid].o]
-
-    verbose -log "checking $lang for __int128"
-    gdb_produce_source $src {
+    return [gdb_can_simple_compile "i128-for-$lang" {
 	__int128 x;
 	int main() { return 0; }
-    }
-
-    set lines [gdb_compile $src $obj object [list nowarnings quiet $lang]]
-    file delete $src
-    file delete $obj
-
-    set result [expr {!![string match "" $lines]}]
-    verbose -log "__int128 for $lang result = $result"
-    return $result
+    } executable {$lang}]
 }
 
 # Return true if the C compiler understands the __int128 type.
@@ -3524,6 +3405,45 @@ gdb_caching_proc universal_compile_options {
     return $options
 }
 
+# Compile the code in $code to a file based on $name.
+# Return 1 if code can be compiled
+# Delete all created files and objects.
+
+proc gdb_can_simple_compile {name code {type object} {compile_flags {}}} {
+
+    switch -regexp -- $type {
+        "executable" {
+            set postfix "x"
+        }
+        "object" {
+            set postfix "o"
+        }
+        "preprocess" {
+            set postfix "i"
+        }
+        "assembly" {
+            set postfix "s"
+        }
+    }
+    set src [standard_temp_file $name-[pid].c]
+    set obj [standard_temp_file $name-[pid].$postfix]
+    set compile_flags [concat $compile_flags {debug nowarnings quiet}]
+
+    gdb_produce_source $src $code
+
+    verbose "$name:  compiling testfile $src" 2
+    set lines [gdb_compile $src $obj $type $compile_flags]
+
+    file delete $src
+    file delete $obj
+
+    if ![string match "" $lines] then {
+        verbose "$name:  compilation failed, returning 0" 2
+        return 0
+    }
+    return 1
+}
+
 # Some targets need to always link a special object in.  Save its path here.
 global gdb_saved_set_unbuffered_mode_obj
 set gdb_saved_set_unbuffered_mode_obj ""
-- 
2.15.2 (Apple Git-101.1)

[PATCH 0/2] Testsuite: Add simple compile routines

[Alan Hayward]

These two patches add two functions to reduce repeated code in the
testsuite library. Most benefit is in the first patch, but it made
sense to add the second patch for completeness.

I wrote these as part of another series, but it might no longer be
relevant for that series, so I split it out.

I've manually tested as many of these routines by using runtest on
the appropiate tests. There are a couple, such as the power extension
checks that I couldn't run, however those changes are the same as other
blocks which have been tested.

Alan Hayward (2):
  Testsuite: Add gdb_can_simple_compile
  Testsuite: Add gdb_simple_compile

 gdb/testsuite/lib/gdb.exp | 431 ++++++++++++++--------------------------------
 1 file changed, 133 insertions(+), 298 deletions(-)

-- 
2.15.2 (Apple Git-101.1)

Re: [PATCH 1/2] Testsuite: Add gdb_can_simple_compile

[Tom Tromey]

>>>>> "Alan" == Alan Hayward <alan.hayward@arm.com> writes:

Alan> Simplfy gdb.exp by adding a function that will attempt to
Alan> compile a piece of code, then clean up.

Thank you.  This looks like a good cleanup.

Alan>  # A helper that compiles a test case to see if __int128 is supported.
Alan>  proc gdb_int128_helper {lang} {
Alan> -    set src [standard_temp_file i128[pid].c]
Alan> -    set obj [standard_temp_file i128[pid].o]
Alan> -
Alan> -    verbose -log "checking $lang for __int128"
Alan> -    gdb_produce_source $src {
Alan> +    return [gdb_can_simple_compile "i128-for-$lang" {
Alan>  	__int128 x;
Alan>  	int main() { return 0; }
Alan> -    }
Alan> -
Alan> -    set lines [gdb_compile $src $obj object [list nowarnings quiet $lang]]
Alan> -    file delete $src
Alan> -    file delete $obj
Alan> -
Alan> -    set result [expr {!![string match "" $lines]}]
Alan> -    verbose -log "__int128 for $lang result = $result"
Alan> -    return $result
Alan> +    } executable {$lang}]

This hunk seems incorrect -- it over-quotes $lang.  I think instead the
{} around that should be removed.

This is ok with this fixed (or explained if I'm incorrect :).

Tom

Re: [PATCH 2/2] Testsuite: Add gdb_simple_compile

[Tom Tromey]

>>>>> "Alan" == Alan Hayward <alan.hayward@arm.com> writes:

Alan> Simplfy gdb.exp by adding a function that will attempt to
Alan> compile a piece of code, then clean up, leaving the created
Alan> object.

Thanks for doing this.

Alan> +    global obj
Alan> +    set src { int foo () {return 0;} }
Alan> +    if {![gdb_simple_compile elf_target $src]} {
Alan> +        return 0
Alan>      }

It would be better not to use a global for this.

One possibility is to have the caller pass in the variable name and then
to have the callee use upvar.  Or, some other parts of gdb.exp just pick
a variable name to inject into the caller using upvar.  The first is
maybe a little nicer.

Alan>      # Make sure we have a compiler that understands altivec.
Alan> -    set compile_flags {debug nowarnings}

I hadn't noticed this in the first patch but I see now that
gdb_can_simple_compile / gdb_simple_compile set the default compiler flags.

Maybe it would be better to have this just be a default and let callers
override it?

Tom

Re: [PATCH 2/2] Testsuite: Add gdb_simple_compile

[Alan Hayward]

> On 6 Sep 2018, at 16:10, Tom Tromey <tom@tromey.com> wrote:
> 
>>>>>> "Alan" == Alan Hayward <alan.hayward@arm.com> writes:
> 
> Alan> Simplfy gdb.exp by adding a function that will attempt to
> Alan> compile a piece of code, then clean up, leaving the created
> Alan> object.
> 
> Thanks for doing this.
> 
> Alan> +    global obj
> Alan> +    set src { int foo () {return 0;} }
> Alan> +    if {![gdb_simple_compile elf_target $src]} {
> Alan> +        return 0
> Alan>      }
> 
> It would be better not to use a global for this.
> 
> One possibility is to have the caller pass in the variable name and then
> to have the callee use upvar.  Or, some other parts of gdb.exp just pick
> a variable name to inject into the caller using upvar.  The first is
> maybe a little nicer.

I’ll look into using upvar.

> 
> Alan>      # Make sure we have a compiler that understands altivec.
> Alan> -    set compile_flags {debug nowarnings}
> 
> I hadn't noticed this in the first patch but I see now that
> gdb_can_simple_compile / gdb_simple_compile set the default compiler flags.
> 
> Maybe it would be better to have this just be a default and let callers
> override it?

My reasoning was that you would always want both debug and nowarnings.
Didn’t see anywhere that didn’t use them. So I always append those two to
the passed in flags. Happy to move them to the default param.


Alan.

Re: [PATCH 1/2] Testsuite: Add gdb_can_simple_compile

[Alan Hayward]

> On 6 Sep 2018, at 15:21, Tom Tromey <tom@tromey.com> wrote:
> 
>>>>>> "Alan" == Alan Hayward <alan.hayward@arm.com> writes:
> 
> Alan> Simplfy gdb.exp by adding a function that will attempt to
> Alan> compile a piece of code, then clean up.
> 
> Thank you.  This looks like a good cleanup.
> 
> Alan>  # A helper that compiles a test case to see if __int128 is supported.
> Alan>  proc gdb_int128_helper {lang} {
> Alan> -    set src [standard_temp_file i128[pid].c]
> Alan> -    set obj [standard_temp_file i128[pid].o]
> Alan> -
> Alan> -    verbose -log "checking $lang for __int128"
> Alan> -    gdb_produce_source $src {
> Alan> +    return [gdb_can_simple_compile "i128-for-$lang" {
> Alan>  	__int128 x;
> Alan>  	int main() { return 0; }
> Alan> -    }
> Alan> -
> Alan> -    set lines [gdb_compile $src $obj object [list nowarnings quiet $lang]]
> Alan> -    file delete $src
> Alan> -    file delete $obj
> Alan> -
> Alan> -    set result [expr {!![string match "" $lines]}]
> Alan> -    verbose -log "__int128 for $lang result = $result"
> Alan> -    return $result
> Alan> +    } executable {$lang}]
> 
> This hunk seems incorrect -- it over-quotes $lang.  I think instead the
> {} around that should be removed.
> 
> This is ok with this fixed (or explained if I'm incorrect :).

The flags parameter for gdb_can_simple_compile is a list, so I’m passing in {$lang}.
I don’t think I can pass in just $lang (I’m learning tcl syntax as I write these
patches, so I’m not sure).


Thanks for the reviews,
Alan.

Re: [PATCH 1/2] Testsuite: Add gdb_can_simple_compile

[Tom Tromey]

>>>>> "Alan" == Alan Hayward <Alan.Hayward@arm.com> writes:

Alan> +    } executable {$lang}]

>> This hunk seems incorrect -- it over-quotes $lang.  I think instead the
>> {} around that should be removed.
>> 
>> This is ok with this fixed (or explained if I'm incorrect :).

Alan> The flags parameter for gdb_can_simple_compile is a list, so I’m passing in {$lang}.
Alan> I don’t think I can pass in just $lang (I’m learning tcl syntax as I write these
Alan> patches, so I’m not sure).

If I did the editing ok the proc looks like:

    proc gdb_int128_helper {lang} {
       return [gdb_can_simple_compile "i128-for-$lang" {
           __int128 x;
           int main() { return 0; }
       } executable {$lang}]
    }

This passes the exact text (without substitution) $lang to
gdb_can_simple_compile, because {} prevents substitutions.

Here's an interactive example:

    % proc print {arg} {
      puts $arg
    }
    % print 23
    23
    % set lang 23
    23
    % print $lang
    23
    % print {$lang}
    $lang

If you want to pass a list, but have variable values in the list, then
use [list]:

    % print [list $lang]
    23

(In Tcl a list with a single "simple" element is just the element, which
can be confusing if you look at the actual bits.  But if you pretend
there is a type system then it all works out.)

You can see the difference if the list needs quoting:

    % set list "a b"
    a b
    % print $list
    a b
    % print [list $list]
    {a b}

Or:

    % llength $list
    2
    % llength [list $list]
    1

Not sure if I'm helping or harming at this point.

Tom

Re: [PATCH 2/2] Testsuite: Add gdb_simple_compile

[Tom Tromey]

>>>>> "Alan" == Alan Hayward <Alan.Hayward@arm.com> writes:

>> I hadn't noticed this in the first patch but I see now that
>> gdb_can_simple_compile / gdb_simple_compile set the default compiler flags.
>> 
>> Maybe it would be better to have this just be a default and let callers
>> override it?

Alan> My reasoning was that you would always want both debug and nowarnings.
Alan> Didn’t see anywhere that didn’t use them. So I always append those two to
Alan> the passed in flags. Happy to move them to the default param.

It's fine with me if you'd rather keep it, but I think it would be nice
if the proc's intro comment mentioned this.

Tom

Re: [PATCH 1/2] Testsuite: Add gdb_can_simple_compile

[Alan Hayward]

> On 9 Sep 2018, at 19:43, Tom Tromey <tom@tromey.com> wrote:
> 
>>>>>> "Alan" == Alan Hayward <Alan.Hayward@arm.com> writes:
> 
> Alan> +    } executable {$lang}]
> 
>>> This hunk seems incorrect -- it over-quotes $lang.  I think instead the
>>> {} around that should be removed.
>>> 
>>> This is ok with this fixed (or explained if I'm incorrect :).
> 
> Alan> The flags parameter for gdb_can_simple_compile is a list, so I’m passing in {$lang}.
> Alan> I don’t think I can pass in just $lang (I’m learning tcl syntax as I write these
> Alan> patches, so I’m not sure).
> 
> If I did the editing ok the proc looks like:
> 
>    proc gdb_int128_helper {lang} {
>       return [gdb_can_simple_compile "i128-for-$lang" {
>           __int128 x;
>           int main() { return 0; }
>       } executable {$lang}]
>    }
> 
> This passes the exact text (without substitution) $lang to
> gdb_can_simple_compile, because {} prevents substitutions.
> 
> Here's an interactive example:
> 
>    % proc print {arg} {
>      puts $arg
>    }
>    % print 23
>    23
>    % set lang 23
>    23
>    % print $lang
>    23
>    % print {$lang}
>    $lang
> 
> If you want to pass a list, but have variable values in the list, then
> use [list]:
> 
>    % print [list $lang]
>    23
> 
> (In Tcl a list with a single "simple" element is just the element, which
> can be confusing if you look at the actual bits.  But if you pretend
> there is a type system then it all works out.)
> 
> You can see the difference if the list needs quoting:
> 
>    % set list "a b"
>    a b
>    % print $list
>    a b
>    % print [list $list]
>    {a b}
> 
> Or:
> 
>    % llength $list
>    2
>    % llength [list $list]
>    1
> 
> Not sure if I'm helping or harming at this point.
> 

I had a quick play with expect manually, and, yes you’re right.
Using this:

proc simple {{compile_flags {}}} {
    set compile_flags [concat $compile_flags {debug nowarnings quiet}]

    foreach c $compile_flags {
    puts $c
    }
}

Gives:

% simple 23
23
debug
nowarnings
quiet
% simple {d e f}
d
e
f
debug
nowarnings
quiet


I’ve changed {$lang} to $lang as requested, updated the proc intro comment (as per 2/2 review), and pushed.
Might be a day or so until I get round to re-doing 2/2.

Thanks,
Alan.