[1/2] Testsuite: Add gdb_can_simple_compile

Message ID 20180906105549.4366-2-alan.hayward@arm.com
State New, archived
Headers

Commit Message

Alan Hayward Sept. 6, 2018, 10:55 a.m. UTC
  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(-)
  

Comments

Tom Tromey Sept. 6, 2018, 2:21 p.m. UTC | #1
>>>>> "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
  
Alan Hayward Sept. 9, 2018, 5:13 p.m. UTC | #2
> 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.
  
Tom Tromey Sept. 9, 2018, 6:43 p.m. UTC | #3
>>>>> "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
  
Alan Hayward Sept. 12, 2018, 11:08 a.m. UTC | #4
> 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.
  

Patch

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