gas/testsuite/lib/gas-defs.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., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  16
  17 # Please email any bugs, comments, and/or additions to this file to:
  18 # DejaGnu@cygnus.com
  19
  20 # This file was written by Ken Raeburn (raeburn@cygnus.com).
  21
  22 proc gas_version {} {
  23     global AS
  24     catch "exec $AS -version < /dev/null" tmp
  25     # Should find a way to discard constant parts, keep whatever's
  26     # left, so the version string could be almost anything at all...
  27     regexp "version (cygnus-|)\[-0-9.a-zA-Z-\]+" $tmp version
  28     set tmp $version
  29     clone_output "[which $AS] $version\n"
  30     unset tmp
  31     unset version
  32 }
  33
  34 proc gas_run { prog as_opts redir } {
  35     global AS
  36     global ASFLAGS
  37     global comp_output
  38     global srcdir
  39     global subdir
  40
  41     verbose "Executing $AS $ASFLAGS $as_opts $prog $redir"
  42     catch "exec $srcdir/lib/run $AS $ASFLAGS $as_opts $srcdir/$subdir/$prog $redir" comp_output
  43 }
  44
  45 proc all_ones { args } {
  46     foreach x $args { if [expr $x!=1] { return 0 } }
  47     return 1
  48 }
  49
  50 proc gas_start { prog as_opts } {
  51     global AS
  52     global ASFLAGS
  53     global srcdir
  54     global subdir
  55     global spawn_id
  56
  57     verbose "Starting $AS $ASFLAGS $as_opts $prog" 2
  58     catch {
  59         spawn -noecho -nottyinit $srcdir/lib/run $AS $ASFLAGS $as_opts $srcdir/$subdir/$prog
  60     } foo
  61     if ![regexp {^[0-9]+} $foo] then {
  62  perror "Can't run $subdir/$prog: $foo"
  63     }
  64 }
  65
  66 proc gas_finish { } {
  67     global spawn_id
  68
  69 # Don't need to do anything?
  70 }
  71
  72 proc want_no_output { testname } {
  73     global comp_output
  74
  75     if ![string match "" $comp_output] then {
  76         send_log "$comp_output\n"
  77         verbose "$comp_output" 3
  78     }
  79     if [string match "" $comp_output] then {
  80         pass "$testname"
  81         return 1
  82     } else {
  83         fail "$testname"
  84         return 0
  85     }
  86 }
  87
  88 proc gas_test_old { file as_opts testname } {
  89     gas_run $file $as_opts ""
  90     return [want_no_output $testname]
  91 }
  92
  93 proc gas_test { file as_opts var_opts testname } {
  94     global comp_output
  95
  96     set i 0
  97     foreach word $var_opts {
  98         set ignore_stdout($i) [string match "*>" $word]
  99         set opt($i) [string trim $word {>}]
 100         incr i
 101     }
 102     set max [expr 1<<$i]
 103     for {set i 0} {[expr $i<$max]} {incr i} {
 104         set maybe_ignore_stdout ""
 105         set extra_opts ""
 106         for {set bit 0} {(1<<$bit)<$max} {incr bit} {
 107             set num [expr 1<<$bit]
 108             if [expr $i&$num] then {
 109                 set extra_opts "$extra_opts $opt($bit)"
 110                 if $ignore_stdout($bit) then {
 111                     set maybe_ignore_stdout "1>/dev/null"
 112                 }
 113             }
 114         }
 115         set extra_opts [string trim $extra_opts]
 116         gas_run $file "$as_opts $extra_opts" $maybe_ignore_stdout
 117
 118         # Should I be able to use a conditional expression here?
 119         if [string match "" $extra_opts] then {
 120             want_no_output $testname
 121         } else {
 122             want_no_output "$testname ($extra_opts)"
 123         }
 124     }
 125     if [info exists errorInfo] then {
 126         unset errorInfo
 127     }
 128 }
 129
 130 proc gas_test_ignore_stdout { file as_opts testname } {
 131     global comp_output
 132
 133     gas_run $file $as_opts "2>&1 1>/dev/null"
 134     want_no_output $testname
 135 }
 136
 137 proc gas_test_error { file as_opts testname } {
 138     global comp_output
 139
 140     gas_run $file $as_opts "2>&1 1>/dev/null"
 141     if ![string match "" $comp_output] then {
 142         send_log "$comp_output\n"
 143         verbose "$comp_output" 3
 144     }
 145     if [string match "" $comp_output] then {
 146         fail "$testname"
 147     } else {
 148         pass "$testname"
 149     }
 150 }
 151
 152 proc gas_exit {} {}
 153
 154 proc gas_init {} {
 155     global target_cpu
 156     global target_cpu_family
 157     global target_family
 158     global target_vendor
 159     global target_os
 160     global stdoptlist
 161
 162     case "$target_cpu" in {
 163         "m68???"                { set target_cpu_family m68k }
 164         "i[34]86"               { set target_cpu_family i386 }
 165         default                 { set target_cpu_family $target_cpu }
 166     }
 167
 168     set target_family "$target_cpu_family-$target_vendor-$target_os"
 169     set stdoptlist "-a>"
 170     # Need to return an empty string.
 171     return
 172 }
 173
 174 proc objdump { opts } {
 175     global OBJDUMP
 176     global comp_output
 177
 178     catch "exec $OBJDUMP $opts" comp_output
 179     verbose "objdump output=$comp_output\n" 3
 180 }
 181
 182 proc objdump_start_no_subdir { prog opts } {
 183     global OBJDUMP
 184     global srcdir
 185     global spawn_id
 186
 187     verbose "Starting $OBJDUMP $opts $prog" 2
 188     catch {
 189         spawn -noecho -nottyinit $srcdir/lib/run $OBJDUMP $opts $prog
 190     } foo
 191     if ![regexp {^[0-9]+} $foo] then {
 192  perror "Can't run $prog: $foo"
 193     }
 194 }
 195
 196 proc objdump_finish { } {
 197     global spawn_id
 198
 199 # Don't need to do anything?
 200 }
 201
 202 expect_after {
 203     timeout                     { perror "timeout" }
 204     "virtual memory exhausted"  { perror "virtual memory exhausted" }
 205     buffer_full                 { perror "buffer full" }
 206     eof                         { perror "eof" }
 207 }
 208
 209 # regexp_diff, based on simple_diff taken from ld test suite
 210 #       compares two files line-by-line
 211 #       file1 contains strings, file2 contains regexps and #-comments
 212 #       blank lines are ignored in either file
 213 #       returns non-zero if differences exist
 214 #
 215 proc regexp_diff { file_1 file_2 } {
 216
 217     set eof -1
 218     set end 0
 219     set differences 0
 220
 221     if [file exists $file_1] then {
 222         set file_a [open $file_1 r]
 223     } else {
 224         warning "$file_1 doesn't exist"
 225         return
 226     }
 227
 228     if [file exists $file_2] then {
 229         set file_b [open $file_2 r]
 230     } else {
 231         fail "$file_2 doesn't exist"
 232         close $file_a
 233         return
 234     }
 235
 236     verbose " Regexp-diff'ing: $file_1 $file_2" 2
 237
 238     while { $differences == 0 && $end == 0 } {
 239         set line_a ""
 240         set line_b ""
 241         while { [string length $line_a] == 0 } {
 242             if { [gets $file_a line_a] == $eof } {
 243                 set end 1
 244                 break
 245             }
 246         }
 247         while { [string length $line_b] == 0 || [string match "#*" $line_b] } {
 248             if { [gets $file_b line_b] == $eof } {
 249                 set end 1
 250                 break
 251             }
 252         }
 253         if { $end } { break }
 254         verbose "regexp \"^$line_b$\"\nline   \"$line_a\"" 3
 255         if [regexp "^$line_b$" "$line_a\n"] {
 256                 verbose "no match" 3
 257                 set differences 1
 258         }
 259     }
 260
 261     if { $differences == 0 && [eof $file_a] != [eof $file_b] } {
 262         verbose "different lengths" 3
 263         set differences 1
 264     }
 265
 266     close $file_a
 267     close $file_b
 268
 269     return $differences
 270 }