binutils/testsuite/lib/utils-lib.exp

   1 # Copyright (C) 1993-2019 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  16
  17 # Please email any bugs, comments, and/or additions to this file to:
  18 # bug-dejagnu@prep.ai.mit.edu
  19
  20 # This file was written by Rob Savoye <rob@cygnus.com>
  21 # and extended by Ian Lance Taylor <ian@cygnus.com>
  22
  23 proc load_common_lib { name } {
  24     load_lib $name
  25 }
  26
  27 load_common_lib binutils-common.exp
  28
  29 proc binutil_version { prog } {
  30     if ![is_remote host] {
  31         set path [which $prog]
  32         if {$path == 0} then {
  33             perror "$prog can't be run, file not found."
  34             return ""
  35         }
  36     } else {
  37         set path $prog
  38     }
  39     set state [remote_exec host $prog --version]
  40     set tmp "[lindex $state 1]\n"
  41     # Should find a way to discard constant parts, keep whatever's
  42     # left, so the version string could be almost anything at all...
  43     regexp "\[^\n\]* (cygnus-|)(\[-0-9.a-zA-Z-\]+)\[\r\n\].*" "$tmp" version cyg number
  44     if ![info exists number] then {
  45         return "$path (no version number)\n"
  46     }
  47     return "$path $number\n"
  48 }
  49
  50 #
  51 # default_binutils_run
  52 #       run a program, returning the output
  53 #       sets binutils_run_failed if the program does not exist
  54 #       sets binutils_run_status to the exit status of the program
  55 #
  56 proc default_binutils_run { prog progargs } {
  57     global binutils_run_failed
  58     global binutils_run_status
  59     global host_triplet
  60
  61     set binutils_run_failed 0
  62     if [info exists binutils_run_status] {
  63         unset binutils_run_status
  64     }
  65
  66     if ![is_remote host] {
  67         if {[which $prog] == 0} then {
  68             perror "$prog does not exist"
  69             set binutils_run_failed 1
  70             return ""
  71         }
  72     }
  73
  74     # For objdump, automatically translate standard section
  75     # names to the targets one, if they are different.
  76     set sect_names [get_standard_section_names]
  77     if { $sect_names != "" && [string match "*objdump" $prog] } {
  78         regsub -- "-j \\.text" $progargs "-j [lindex $sect_names 0]" progargs
  79         regsub -- "-j \\.data" $progargs "-j [lindex $sect_names 1]" progargs
  80         regsub -- "-j \\.bss"  $progargs "-j [lindex $sect_names 2]" progargs
  81     }
  82
  83     send_log "$prog $progargs\n"
  84     verbose "$prog $progargs"
  85
  86     # Gotta quote dollar-signs because they get mangled by the
  87     # shell otherwise.
  88     regsub -all "\\$" "$progargs" "\\$" progargs
  89
  90     set state [remote_exec host $prog $progargs]
  91     set binutils_run_status [lindex $state 0]
  92     set exec_output [prune_warnings [lindex $state 1]]
  93     if {![string match "" $exec_output]} then {
  94         send_log "$exec_output\n"
  95         verbose "$exec_output"
  96     } else {
  97         if { [lindex $state 0] != 0 } {
  98             set exec_output "$prog exited with status [lindex $state 0]"
  99             send_log "$exec_output\n"
 100             verbose "$exec_output"
 101         }
 102     }
 103     return $exec_output
 104 }
 105
 106 #
 107 # default_binutils_assemble_flags
 108 #       assemble a file
 109 #
 110 proc default_binutils_assemble_flags { source object asflags } {
 111     global srcdir
 112     global host_triplet
 113
 114     # The HPPA assembler syntax is a little different than most, to make
 115     # the test source file assemble we need to run it through sed.
 116     #
 117     # This is a hack in that it won't scale well if other targets need
 118     # similar transformations to assemble.  We'll generalize the hack
 119     # if/when other targets need similar handling.
 120     if { [istarget "hppa*-*-*"] \
 121              && ![istarget "*-*-linux*"] \
 122              && ![istarget "*-*-netbsd*" ] } {
 123         set sed_file $srcdir/config/hppa.sed
 124         send_log "sed -f $sed_file < $source > asm.s\n"
 125         verbose "sed -f $sed_file < $source > asm.s"
 126         catch "exec sed -f $sed_file < $source > asm.s"
 127         set source asm.s
 128     }
 129
 130     set exec_output [target_assemble $source $object $asflags]
 131     set exec_output [prune_warnings $exec_output]
 132
 133     if [string match "" $exec_output] {
 134         return 1
 135     } else {
 136         send_log "$exec_output\n"
 137         verbose "$exec_output"
 138         return 0
 139     }
 140 }
 141
 142 #
 143 # exe_ext
 144 #       Returns target executable extension, if any.
 145 #
 146 proc exe_ext {} {
 147     if { [istarget *-*-mingw*] || [istarget *-*-cygwin*] } {
 148         return ".exe"
 149     } else {
 150         return ""
 151     }
 152 }
 153
 154 proc verbose_eval { expr { level 1 } } {
 155     global verbose
 156     if $verbose>$level then { eval verbose "$expr" $level }
 157 }