binutils/testsuite/lib/utils-lib.exp

   1 # Copyright (C) 1993-2022 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 # [email protected]
  19
  20 # This file was written by Rob Savoye <[email protected]>
  21 # and extended by Ian Lance Taylor <[email protected]>
  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     # Gotta quote dollar-signs because they get mangled by the
  84     # shell otherwise.  Since get_standard_section_names returns
  85     # quoted section names, we first remove the original quote
  86     # and then requote.
  87     regsub -all {\\\$} "$progargs" {$} progargs
  88     regsub -all {\$} "$progargs" {\$} progargs
  89
  90     send_log "$prog $progargs\n"
  91     verbose "$prog $progargs"
  92
  93     set state [remote_exec host $prog $progargs]
  94     set binutils_run_status [lindex $state 0]
  95     set exec_output [prune_warnings [lindex $state 1]]
  96     if {![string match "" $exec_output]} then {
  97         send_log "$exec_output\n"
  98         verbose "$exec_output"
  99     } else {
 100         if { [lindex $state 0] != 0 } {
 101             set exec_output "$prog exited with status [lindex $state 0]"
 102             send_log "$exec_output\n"
 103             verbose "$exec_output"
 104         }
 105     }
 106     return $exec_output
 107 }
 108
 109 #
 110 # default_binutils_assemble_flags
 111 #       assemble a file
 112 #
 113 proc default_binutils_assemble_flags { source object asflags } {
 114     global srcdir
 115     global host_triplet
 116
 117     # The HPPA assembler syntax is a little different than most, to make
 118     # the test source file assemble we need to run it through sed.
 119     #
 120     # This is a hack in that it won't scale well if other targets need
 121     # similar transformations to assemble.  We'll generalize the hack
 122     # if/when other targets need similar handling.
 123     if { [istarget "hppa*-*-*"] \
 124              && ![istarget "*-*-linux*"] \
 125              && ![istarget "*-*-netbsd*" ] } {
 126         set sed_file $srcdir/config/hppa.sed
 127         send_log "sed -f $sed_file < $source > asm.s\n"
 128         verbose "sed -f $sed_file < $source > asm.s"
 129         catch "exec sed -f $sed_file < $source > asm.s"
 130         set source asm.s
 131     }
 132
 133     set exec_output [target_assemble $source $object $asflags]
 134     set exec_output [prune_warnings $exec_output]
 135
 136     if [string match "" $exec_output] {
 137         return 1
 138     } else {
 139         send_log "$exec_output\n"
 140         verbose "$exec_output"
 141         return 0
 142     }
 143 }
 144
 145 #
 146 # exe_ext
 147 #       Returns target executable extension, if any.
 148 #
 149 proc exe_ext {} {
 150     if { [istarget *-*-mingw*] || [istarget *-*-cygwin*] } {
 151         return ".exe"
 152     } else {
 153         return ""
 154     }
 155 }
 156
 157 proc verbose_eval { expr { level 1 } } {
 158     global verbose
 159     if $verbose>$level then { eval verbose "$expr" $level }
 160 }