[gdb/testsuite] Fail in gdb_compile if pie results in non-PIE executable

[external/binutils.git] / gdb / testsuite / lib / gdb.exp

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 4c7d3b5..529b6f6 100644 (file)
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -1103,6 +1103,44 @@ proc gdb_test { args } {
      }]
 }
 
+# Return 1 if version MAJOR.MINOR is at least AT_LEAST_MAJOR.AT_LEAST_MINOR.
+proc version_at_least { major minor at_least_major at_least_minor} {
+    if { $major > $at_least_major } {
+        return 1
+    } elseif { $major == $at_least_major \
+                  && $minor >= $at_least_minor } {
+        return 1
+    } else {
+        return 0
+    }
+}
+
+# Return 1 if tcl version used is at least MAJOR.MINOR
+proc tcl_version_at_least { major minor } {
+    global tcl_version
+    regexp {^([0-9]+)\.([0-9]+)$} $tcl_version \
+       dummy tcl_version_major tcl_version_minor
+    return [version_at_least $tcl_version_major $tcl_version_minor \
+               $major $minor]
+}
+
+if { [tcl_version_at_least 8 5] == 0 } {
+    # lrepeat was added in tcl 8.5.  Only add if missing.
+    proc lrepeat { n element } {
+        if { [string is integer -strict $n] == 0 } {
+            error "expected integer but got \"$n\""
+        }
+        if { $n < 0 } {
+            error "bad count \"$n\": must be integer >= 0"
+        }
+        set res [list]
+        for {set i 0} {$i < $n} {incr i} {
+            lappend res $element
+        }
+        return $res
+    }
+}
+
 # gdb_test_no_output COMMAND MESSAGE
 # Send a command to GDB and verify that this command generated no output.
 #
@@ -3120,7 +3158,7 @@ proc skip_libstdcxx_probe_tests_prompt { prompt_regexp } {
        }
        -re "\r\n$prompt_regexp" {
        }
-    }
+    } "$prompt_regexp"
     return $ok
 }
 
@@ -3167,7 +3205,7 @@ proc gdb_is_target_1 { target_name target_stack_regexp prompt_regexp } {
        -re "$prompt_regexp" {
            pass $test
        }
-    }
+    } "$prompt_regexp"
     return 0
 }
 
@@ -3771,6 +3809,16 @@ proc gdb_compile {source dest type options} {
     regsub "\[\r\n\]*$" "$result" "" result
     regsub "^\[\r\n\]*" "$result" "" result
     
+    if { $type == "executable" && $result == "" \
+            && ($nopie != -1 || $pie != -1) } {
+       set is_pie [exec_is_pie "$dest"]
+       if { $nopie != -1 && $is_pie == 1 } {
+           set result "nopie failed to prevent PIE executable"
+       } elseif { $pie != -1 && $is_pie == 0 } {
+           set result "pie failed to generate PIE executable"
+       }
+    }
+
     if {[lsearch $options quiet] < 0} {
        # We shall update this on a per language basis, to avoid
        # changing the entire testsuite in one go.
@@ -5171,6 +5219,58 @@ proc exec_has_index_section { executable } {
     return 0
 }
 
+# Return list with major and minor version of readelf, or an empty list.
+gdb_caching_proc readelf_version {
+    set readelf_program [gdb_find_readelf]
+    set res [catch {exec $readelf_program --version} output]
+    if { $res != 0 } {
+       return [list]
+    }
+    set lines [split $output \n]
+    set line [lindex $lines 0]
+    set res [regexp {[ \t]+([0-9]+)[.]([0-9]+)[^ \t]*$} \
+                $line dummy major minor]
+    if { $res != 1 } {
+       return [list]
+    }
+    return [list $major $minor]
+}
+
+# Return 1 if readelf prints the PIE flag, 0 if is doesn't, and -1 if unknown.
+proc readelf_prints_pie { } {
+    set version [readelf_version]
+    if { [llength $version] == 0 } {
+       return -1
+    }
+    set major [lindex $version 0]
+    set minor [lindex $version 1]
+    # It would be better to construct a PIE executable and test if the PIE
+    # flag is printed by readelf, but we cannot reliably construct a PIE
+    # executable if the multilib_flags dictate otherwise
+    # (--target_board=unix/-no-pie/-fno-PIE).
+    return [version_at_least $major $minor 2 26]
+}
+
+# Return 1 if EXECUTABLE is a Position Independent Executable, 0 if it is not,
+# and -1 if unknown.
+
+proc exec_is_pie { executable } {
+    set res [readelf_prints_pie]
+    if { $res != 1 } {
+       return -1
+    }
+    set readelf_program [gdb_find_readelf]
+    set res [catch {exec $readelf_program -d $executable} output]
+    if { $res != 0 } {
+       return -1
+    }
+    set res [regexp -line {\(FLAGS_1\).*Flags:.* PIE($| )} $output]
+    if { $res == 1 } {
+       return 1
+    }
+    return 0
+}
+
 # Return true if a test should be skipped due to lack of floating
 # point support or GDB can't fetch the contents from floating point
 # registers.