testsuite: Introduce dejagnu_version

[deliverable/binutils-gdb.git] / gdb / testsuite / lib / gdb.exp

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 758db46d565927e11d63f25b03672a8539889ac6..c773d41baee49f099526310180fddb1c9d2e9e3a 100644 (file)
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -1,4 +1,4 @@
-# Copyright 1992-2016 Free Software Foundation, Inc.
+# Copyright 1992-2017 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
@@ -28,6 +28,7 @@ if {$tool == ""} {
 load_lib libgloss.exp
 load_lib cache.exp
 load_lib gdb-utils.exp
+load_lib memory.exp
 
 global GDB
 
@@ -117,6 +118,10 @@ set octal "\[0-7\]+"
 
 set inferior_exited_re "(\\\[Inferior \[0-9\]+ \\(.*\\) exited)"
 
+# A regular expression that matches a value history number.
+# E.g., $1, $2, etc.
+set valnum_re "\\\$$decimal"
+
 ### Only procedures should come after this point.
 
 #
@@ -519,7 +524,7 @@ proc runto { function args } {
        }
        -re "The target does not support running in non-stop mode.\r\n$gdb_prompt $" {
            if { $print_fail } {
-               unsupported "Non-stop mode not supported"
+               unsupported "non-stop mode not supported"
            }
            return 0
        }
@@ -1722,12 +1727,6 @@ proc skip_go_tests {} {
     return 0
 }
 
-# Return a 1 if I don't even want to try to test java.
-
-proc skip_java_tests {} {
-    return 0
-}
-
 # Return a 1 if I don't even want to try to test D.
 
 proc skip_d_tests {} {
@@ -1924,6 +1923,14 @@ proc foreach_with_prefix {var list body} {
     }
 }
 
+# Like TCL's native proc, but defines a procedure that wraps its body
+# within 'with_test_prefix "$proc_name" { ... }'.
+proc proc_with_prefix {name arguments body} {
+    # Define the advertised proc.
+    proc $name $arguments [list with_test_prefix $name $body]
+}
+
+
 # Run BODY in the context of the caller.  After BODY is run, the variables
 # listed in VARS will be reset to the values they had before BODY was run.
 #
@@ -2176,6 +2183,13 @@ proc with_timeout_factor { factor body } {
 # Return 1 if _Complex types are supported, otherwise, return 0.
 
 gdb_caching_proc support_complex_tests {
+
+    if { [gdb_skip_float_test] } {
+       # If floating point is not supported, _Complex is not
+       # supported.
+       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.
@@ -3137,7 +3151,7 @@ gdb_caching_proc target_is_gdbserver {
     global gdb_prompt
 
     set is_gdbserver -1
-    set test "Probing for GDBserver"
+    set test "probing for GDBserver"
 
     gdb_test_multiple "monitor help" $test {
        -re "The following monitor commands are supported.*Quit GDBserver.*$gdb_prompt $" {
@@ -3289,12 +3303,8 @@ proc get_compiler_info {{arg ""}} {
     }
 
     # Set the legacy symbols.
-    set gcc_compiled     0
-    if { [regexp "^gcc-1-" "$compiler_info" ] } { set gcc_compiled 1 }
-    if { [regexp "^gcc-2-" "$compiler_info" ] } { set gcc_compiled 2 }
-    if { [regexp "^gcc-3-" "$compiler_info" ] } { set gcc_compiled 3 }
-    if { [regexp "^gcc-4-" "$compiler_info" ] } { set gcc_compiled 4 }
-    if { [regexp "^gcc-5-" "$compiler_info" ] } { set gcc_compiled 5 }
+    set gcc_compiled 0
+    regexp "^gcc-(\[0-9\]+)-" "$compiler_info" matchall gcc_compiled
 
     # Log what happened.
     verbose -log "get_compiler_info: $compiler_info"
@@ -3593,7 +3603,7 @@ proc gdb_compile_pthreads {source dest type options} {
         }
     }
     if {!$built_binfile} {
-       unsupported "Couldn't compile [file tail $source]: ${why_msg}"
+       unsupported "couldn't compile [file tail $source]: ${why_msg}"
         return -1
     }
 }
@@ -3722,7 +3732,7 @@ proc gdb_compile_shlib_pthreads {sources dest options} {
         }
     }
     if {!$built_binfile} {
-        unsupported "Couldn't compile $sources: ${why_msg}"
+        unsupported "couldn't compile $sources: ${why_msg}"
         return -1
     }
 }
@@ -3762,7 +3772,7 @@ proc gdb_compile_objc {source dest type options} {
         }
     }
     if {!$built_binfile} {
-        unsupported "Couldn't compile [file tail $source]: ${why_msg}"
+        unsupported "couldn't compile [file tail $source]: ${why_msg}"
         return -1
     }
 }
@@ -5020,9 +5030,14 @@ proc gdb_skip_bogus_test { msg } {
 # NOTE: This must be called while gdb is *not* running.
 
 gdb_caching_proc gdb_skip_xml_test {
+    global gdb_spawn_id
     global gdb_prompt
     global srcdir
 
+    if { [info exists gdb_spawn_id] } {
+        error "GDB must not be running in gdb_skip_xml_tests."
+    }
+
     set xml_file [gdb_remote_download host "${srcdir}/gdb.xml/trivial.xml"]
 
     gdb_start
@@ -5585,6 +5600,30 @@ proc get_target_charset { } {
     return "UTF-8"
 }
 
+# Get the address of VAR.
+
+proc get_var_address { var } {
+    global gdb_prompt hex
+
+    # Match output like:
+    # $1 = (int *) 0x0
+    # $5 = (int (*)()) 0
+    # $6 = (int (*)()) 0x24 <function_bar>
+
+    gdb_test_multiple "print &${var}" "get address of ${var}" {
+       -re "\\\$\[0-9\]+ = \\(.*\\) (0|$hex)( <${var}>)?\[\r\n\]+${gdb_prompt} $"
+       {
+           pass "get address of ${var}"
+           if { $expect_out(1,string) == "0" } {
+               return "0x0"
+           } else {
+               return $expect_out(1,string)
+           }
+       }
+    }
+    return ""
+}
+
 # Get the current value for remotetimeout and return it.
 proc get_remotetimeout { } {
     global gdb_prompt
@@ -5976,5 +6015,40 @@ proc multi_line { args } {
     return [join $args "\r\n"]
 }
 
+# Similar to the above, but while multi_line is meant to be used to
+# match GDB output, this one is meant to be used to build strings to
+# send as GDB input.
+
+proc multi_line_input { args } {
+    return [join $args "\n"]
+}
+
+# Return the version of the DejaGnu framework.
+#
+# The return value is a list containing the major, minor and patch version
+# numbers.  If the version does not contain a minor or patch number, they will
+# be set to 0.  For example:
+#
+#   1.6   -> {1 6 0}
+#   1.6.1 -> {1 6 1}
+#   2     -> {2 0 0}
+
+proc dejagnu_version { } {
+    # The frame_version variable is defined by DejaGnu, in runtest.exp.
+    global frame_version
+
+    verbose -log "DejaGnu version: $frame_version"
+    verbose -log "Expect version: [exp_version]"
+    verbose -log "Tcl version: [info tclversion]"
+
+    set dg_ver [split $frame_version .]
+
+    while { [llength $dg_ver] < 3 } {
+       lappend dg_ver 0
+    }
+
+    return $dg_ver
+}
+
 # Always load compatibility stuff.
 load_lib future.exp