binutils/testsuite/lib/utils-lib.exp

   1 #   Copyright (C) 1993, 1994 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 2 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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 binutil_version { prog } {
  24     if {[which $prog] == 0} then {
  25         perror "$prog can't be run, file not found."
  26         return ""
  27     }
  28     catch "exec $prog --version" tmp
  29     # Should find a way to discard constant parts, keep whatever's
  30     # left, so the version string could be almost anything at all...
  31     regexp "version (cygnus-|)\[-0-9.a-zA-Z-\]+" $tmp version
  32     if ![info exists version] then {
  33         return "[which $prog] (no version number)\n"
  34     }
  35     set tmp $version
  36     return "[which $prog] $version\n"
  37 }
  38
  39 #
  40 # default_binutils_run
  41 #       run a program, returning the output
  42 #       sets binutils_run_failed if the program does not exist
  43 #
  44 proc default_binutils_run { prog progargs } {
  45     global binutils_run_failed
  46     global host_triplet
  47
  48     set binutils_run_failed 0
  49
  50     if {[which $prog] == 0} then {
  51         perror "$prog does not exist"
  52         set binutils_run_failed 1
  53         return ""
  54     }
  55
  56     send_log "$prog $progargs\n"
  57     verbose "$prog $progargs"
  58
  59     # This used to be
  60     # catch "exec $prog $progargs" exec_output
  61     # but that would evaluate $progargs twice, which would fail if
  62     # any arguments started with `$'.  This is a dismal hack to avoid
  63     # this problem.  I tried using
  64     # catch { exec $prog $progargs } exec_output
  65     # but that failed because $progargs was not split into words by
  66     # exec.  I don't know if this operation can be done correctly.  No
  67     # matter how hard I try, I can not convince myself that TCL is a
  68     # language.
  69     regsub -all "\\$" $progargs "\\$" progq
  70     catch "exec $prog $progq" exec_output
  71     set exec_output [prune_system_crud $host_triplet $exec_output]
  72     if {![string match "" $exec_output]} then {
  73         send_log "$exec_output\n"
  74         verbose "$exec_output"
  75     }
  76     return $exec_output
  77 }
  78
  79 #
  80 # default_binutils_assemble
  81 #       assemble a file
  82 #
  83 proc default_binutils_assemble { as source object } {
  84     global ASFLAGS
  85     global srcdir
  86     global host_triplet
  87
  88     if {[which $as] == 0} then {
  89         perror "$as does not exist"
  90         return 0
  91     }
  92
  93     if ![info exists ASFLAGS] { set ASFLAGS "" }
  94
  95     # The HPPA assembler syntax is a little different than most, to make
  96     # the test source file assemble we need to run it through sed.
  97     #
  98     # This is a hack in that it won't scale well if other targets need
  99     # similar transformations to assemble.  We'll generalize the hack
 100     # if/when other targets need similar handling.
 101     if [istarget "hppa*-*-*" ] then {
 102         send_log "sed -f $srcdir/config/hppa.sed < $source | $as $ASFLAGS -o $object\n"
 103         verbose "sed -f $srcdir/config/hppa.sed < $source | $as $ASFLAGS -o $object"
 104         catch "exec sed -f $srcdir/config/hppa.sed < $source | $as $ASFLAGS -o $object" exec_output
 105     } else {
 106         send_log "$as $ASFLAGS -o $object $source\n"
 107         verbose "$as $ASFLAGS -o $object $source"
 108         catch "exec $as $ASFLAGS -o $object $source" exec_output
 109     }
 110
 111     set exec_output [prune_system_crud $host_triplet $exec_output]
 112
 113     if [string match "" $exec_output] then {
 114         return 1
 115     } else {
 116         send_log "$exec_output\n"
 117         verbose "$exec_output"
 118         perror "$source: assembly failed"
 119         return 0
 120     }
 121 }
 122
 123 #
 124 # default_binutils_compile
 125 #       compile a file
 126 #
 127 proc default_binutils_compile { cc flags source object } {
 128     global CFLAGS
 129     global srcdir
 130     global host_triplet
 131
 132     if {[which $cc] == 0} then {
 133         perror "$cc does not exist"
 134         return 0
 135     }
 136
 137     if ![info exists CFLAGS] { set CFLAGS "" }
 138
 139     send_log "$cc $flags $CFLAGS -o $object $source\n"
 140     verbose "$cc $flags $CFLAGS -o $object $source"
 141     catch "exec $cc $flags $CFLAGS -o $object $source" exec_output
 142
 143     set exec_output [prune_system_crud $host_triplet $exec_output]
 144
 145     if [string match "" $exec_output] then {
 146         return 1
 147     } else {
 148         send_log "$exec_output\n"
 149         verbose "$exec_output"
 150         perror "$source: compilation failed"
 151         return 0
 152     }
 153 }
 154
 155 #
 156 # default_binutils_remove
 157 #       remove a file
 158 #
 159 proc default_binutils_remove { file } {
 160     catch "exec rm -f $file" exec_output
 161 }
 162
 163 # This definition is taken from an unreleased version of DejaGnu.  Once
 164 # that version gets released, and has been out in the world for a few
 165 # months at least, it may be safe to delete this copy.
 166 if ![string length [info proc prune_system_crud]] {
 167     #
 168     # prune_system_crud -- delete various system verbosities from TEXT on SYSTEM
 169     #
 170     # An example is:
 171     # ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
 172     #
 173     # SYSTEM is typical $target_triplet or $host_triplet.
 174     #
 175     # This is useful when trying to do pattern matches on program output.
 176     # Sites with particular verbose os's may wish to override this in site.exp.
 177     #
 178     proc prune_system_crud { system text } {
 179         # This is from sun4's.  Do it for all machines for now.
 180         # The "\\1" is to try to preserve a "\n" but only if necessary.
 181         regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text
 182
 183         # This happens when compiling on Alpha OSF/1 with cc -g -O.
 184         regsub -all "(^|\n)(uopt: Warning: file not optimized; use -g3 if both optimization and debug wanted\n?)+" $text "\\1" text
 185
 186         # This happens on SunOS with cc -g -O.
 187         regsub -all "(^|\n)(cc: Warning: -O conflicts with -g. -O turned off.\n?)+" $text "\\1" text
 188
 189         # It might be tempting to get carried away and delete blank lines, etc.
 190         # Just delete *exactly* what we're ask to, and that's it.
 191         return $text
 192     }
 193 }