1# Copyright (C) 1993-2021 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, 16# MA 02110-1301, USA. 17 18# Please email any bugs, comments, and/or additions to this file to: 19# dejagnu@gnu.org 20 21# This file was written by Ken Raeburn (raeburn@cygnus.com). 22 23proc load_common_lib { name } { 24 global srcdir 25 load_file $srcdir/../../binutils/testsuite/lib/$name 26} 27 28load_common_lib binutils-common.exp 29 30proc gas_version {} { 31 global AS 32 if [is_remote host] then { 33 remote_exec host "$AS -version < /dev/null" "" "" "gas.version" 34 remote_exec host "which $AS" "" "" "gas.which" 35 36 remote_upload host "gas.version" 37 remote_upload host "gas.which" 38 39 set which_as [file_contents "gas.which"] 40 set tmp [file_contents "gas.version"] 41 42 remote_file build delete "gas.version" 43 remote_file build delete "gas.which" 44 remote_file host delete "gas.version" 45 remote_file host delete "gas.which" 46 } else { 47 set which_as [which $AS] 48 catch "exec $AS -version < /dev/null" tmp 49 } 50 51 # Should find a way to discard constant parts, keep whatever's 52 # left, so the version string could be almost anything at all... 53 regexp "\[^\n\]* (cygnus-|)(\[-0-9.a-zA-Z-\]+)\[\r\n\].*" $tmp version cyg number 54 if ![info exists number] then { 55 return "$which_as (no version number)\n" 56 } 57 clone_output "$which_as $number\n" 58 unset version 59} 60 61proc gas_host_run { cmd redir } { 62 verbose "Executing $cmd $redir" 63 set return_contents_of "" 64 if [regexp ">& */dev/null" $redir] then { 65 set output_file "" 66 set command "$cmd $redir" 67 } elseif [regexp "> */dev/null" $redir] then { 68 set output_file "" 69 set command "$cmd 2>gas.stderr" 70 set return_contents_of "gas.stderr" 71 } elseif [regexp ">&.*" $redir] then { 72 # See PR 5322 for why the following line is used. 73 regsub ">&" $redir "" output_file 74 set command "$cmd 2>&1" 75 } elseif [regexp "2>.*" $redir] then { 76 set output_file "gas.out" 77 set command "$cmd $redir" 78 set return_contents_of "gas.out" 79 } elseif [regexp ">.*" $redir] then { 80 set output_file "" 81 set command "$cmd $redir 2>gas.stderr" 82 set return_contents_of "gas.stderr" 83 } elseif { "$redir" == "" } then { 84 set output_file "gas.out" 85 set command "$cmd 2>&1" 86 set return_contents_of "gas.out" 87 } else { 88 fail "gas_host_run: unknown form of redirection string" 89 } 90 91 set status [remote_exec host [concat sh -c [list $command]] "" "/dev/null" "$output_file"] 92 set to_return "" 93 if { "$return_contents_of" != "" } then { 94 remote_upload host "$return_contents_of" 95 set to_return [file_contents "$return_contents_of"] 96 regsub "\n$" $to_return "" to_return 97 } 98 99 if { [lindex $status 0] == 0 && "$output_file" != "" 100 && "$output_file" != "$return_contents_of" } then { 101 remote_upload host "$output_file" 102 } 103 104 return [list [lindex $status 0] "$to_return"] 105} 106 107proc gas_run { prog as_opts redir } { 108 global AS 109 global ASFLAGS 110 global comp_output 111 global srcdir 112 global subdir 113 global host_triplet 114 115 set status [gas_host_run "$AS $ASFLAGS $as_opts $srcdir/$subdir/$prog" "$redir"] 116 set comp_output [lindex $status 1] 117 if { [lindex $status 0] != 0 && [regexp "2>.*" $redir] } then { 118 append comp_output "child process exited abnormally" 119 } 120 set comp_output [prune_warnings $comp_output] 121 verbose "output was $comp_output" 122 return [list $comp_output ""] 123} 124 125proc gas_run_stdin { prog as_opts redir } { 126 global AS 127 global ASFLAGS 128 global comp_output 129 global srcdir 130 global subdir 131 global host_triplet 132 133 set status [gas_host_run "$AS $ASFLAGS $as_opts < $srcdir/$subdir/$prog" "$redir"] 134 set comp_output [lindex $status 1] 135 if { [lindex $status 0] != 0 && [regexp "2>.*" $redir] } then { 136 append comp_output "child process exited abnormally" 137 } 138 set comp_output [prune_warnings $comp_output] 139 verbose "output was $comp_output" 140 return [list $comp_output ""] 141} 142 143proc all_ones { args } { 144 foreach x $args { if [expr $x!=1] { return 0 } } 145 return 1 146} 147 148# ${tool}_finish (gas_finish) will be called by runtest.exp. But 149# gas_finish should only be used with gas_start. We use gas_started 150# to tell gas_finish if gas_start has been called so that runtest.exp 151# can call gas_finish without closing the wrong fd. 152set gas_started 0 153 154proc gas_start { prog as_opts } { 155 global AS 156 global ASFLAGS 157 global srcdir 158 global subdir 159 global spawn_id 160 global gas_started 161 162 set gas_started 1 163 164 verbose -log "Starting $AS $ASFLAGS $as_opts $prog" 2 165 set status [gas_host_run "$AS $ASFLAGS $as_opts $srcdir/$subdir/$prog" ">&gas.out"] 166 spawn -noecho -nottycopy cat gas.out 167} 168 169proc gas_finish { } { 170 global spawn_id 171 global gas_started 172 173 if { $gas_started == 1 } { 174 catch "close" 175 catch "wait" 176 set gas_started 0 177 } 178} 179 180proc want_no_output { testname } { 181 global comp_output 182 183 if ![string match "" $comp_output] then { 184 send_log "$comp_output\n" 185 verbose "$comp_output" 3 186 } 187 if [string match "" $comp_output] then { 188 pass "$testname" 189 return 1 190 } else { 191 fail "$testname" 192 return 0 193 } 194} 195 196proc gas_test_old { file as_opts testname } { 197 gas_run $file $as_opts "" 198 return [want_no_output $testname] 199} 200 201proc gas_test { file as_opts var_opts testname } { 202 global comp_output 203 204 set i 0 205 foreach word $var_opts { 206 set ignore_stdout($i) [string match "*>" $word] 207 set opt($i) [string trim $word {>}] 208 incr i 209 } 210 set max [expr 1<<$i] 211 for {set i 0} {[expr $i<$max]} {incr i} { 212 set maybe_ignore_stdout "" 213 set extra_opts "" 214 for {set bit 0} {(1<<$bit)<$max} {incr bit} { 215 set num [expr 1<<$bit] 216 if [expr $i&$num] then { 217 set extra_opts "$extra_opts $opt($bit)" 218 if $ignore_stdout($bit) then { 219 set maybe_ignore_stdout ">/dev/null" 220 } 221 } 222 } 223 set extra_opts [string trim $extra_opts] 224 gas_run $file "$as_opts $extra_opts" $maybe_ignore_stdout 225 226 # Should I be able to use a conditional expression here? 227 if [string match "" $extra_opts] then { 228 want_no_output $testname 229 } else { 230 want_no_output "$testname ($extra_opts)" 231 } 232 } 233 if [info exists errorInfo] then { 234 unset errorInfo 235 } 236} 237 238proc gas_test_ignore_stdout { file as_opts testname } { 239 global comp_output 240 241 gas_run $file $as_opts ">/dev/null" 242 want_no_output $testname 243} 244 245proc gas_test_error { file as_opts testname } { 246 global comp_output 247 248 gas_run $file $as_opts ">/dev/null" 249 send_log "$comp_output\n" 250 verbose "$comp_output" 3 251 if { ![string match "" $comp_output] 252 && ![string match "*Assertion failure*" $comp_output] 253 && ![string match "*Internal error*" $comp_output] } then { 254 pass "$testname" 255 } else { 256 fail "$testname" 257 } 258} 259 260proc gas_exit {} {} 261 262proc gas_init { args } { 263 global target_cpu 264 global target_cpu_family 265 global target_family 266 global target_vendor 267 global target_os 268 global stdoptlist 269 270 switch -glob "$target_cpu" { 271 "m68???" { set target_cpu_family m68k } 272 "i[3-7]86" { set target_cpu_family i386 } 273 default { set target_cpu_family $target_cpu } 274 } 275 276 set target_family "$target_cpu_family-$target_vendor-$target_os" 277 set stdoptlist "-a>" 278 279 if ![istarget "*-*-*"] { 280 perror "Target name [istarget] is not a triple." 281 } 282 # Need to return an empty string. 283 return 284} 285 286# run_dump_tests TESTCASES EXTRA_OPTIONS 287# Wrapper for run_dump_test, which is suitable for invoking as 288# run_dump_tests [lsort [glob -nocomplain $srcdir/$subdir/*.d]] 289# EXTRA_OPTIONS are passed down to run_dump_test. Honors runtest_file_p. 290# Body cribbed from dg-runtest. 291 292proc run_dump_tests { testcases {extra_options {}} } { 293 global runtests 294 295 foreach testcase $testcases { 296 # If testing specific files and this isn't one of them, skip it. 297 if ![runtest_file_p $runtests $testcase] { 298 continue 299 } 300 run_dump_test [file rootname [file tail $testcase]] $extra_options 301 } 302} 303 304proc objdump { opts } { 305 global OBJDUMP 306 global comp_output 307 global host_triplet 308 309 set status [gas_host_run "$OBJDUMP $opts" ""] 310 set comp_output [prune_warnings [lindex $status 1]] 311 verbose "objdump output=$comp_output\n" 3 312} 313 314proc objdump_start_no_subdir { prog opts } { 315 global OBJDUMP 316 global srcdir 317 global spawn_id 318 319 verbose "Starting $OBJDUMP $opts $prog" 2 320 set status [gas_host_run "$OBJDUMP $opts $prog" ">&gas.out"] 321 spawn -noecho -nottycopy cat gas.out 322} 323 324proc objdump_finish { } { 325 global spawn_id 326 327 catch "close" 328 catch "wait" 329} 330 331# Default timeout is 10 seconds, loses on a slow machine. But some 332# configurations of dejagnu may override it. 333if {$timeout<120} then { set timeout 120 } 334 335expect_after -i { 336 timeout { perror "timeout" } 337 "virtual memory exhausted" { perror "virtual memory exhausted" } 338 buffer_full { perror "buffer full" } 339 eof { perror "eof" } 340} 341 342proc file_contents { filename } { 343 set file [open $filename r] 344 set contents [read $file] 345 close $file 346 return $contents 347} 348 349proc write_file { filename contents } { 350 set file [open $filename w] 351 puts $file "$contents" 352 close $file 353} 354 355proc verbose_eval { expr { level 1 } } { 356 global verbose 357 if $verbose>$level then { eval verbose "$expr" $level } 358} 359 360# This definition is taken from an unreleased version of DejaGnu. Once 361# that version gets released, and has been out in the world for a few 362# months at least, it may be safe to delete this copy. 363if ![string length [info proc prune_warnings]] { 364 # 365 # prune_warnings -- delete various system verbosities from TEXT. 366 # 367 # An example is: 368 # ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9 369 # 370 # Sites with particular verbose os's may wish to override this in site.exp. 371 # 372 proc prune_warnings { text } { 373 # This is from sun4's. Do it for all machines for now. 374 # The "\\1" is to try to preserve a "\n" but only if necessary. 375 regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text 376 377 # It might be tempting to get carried away and delete blank lines, etc. 378 # Just delete *exactly* what we're ask to, and that's it. 379 return $text 380 } 381} 382 383# run_list_test NAME (optional): OPTS TESTNAME 384# 385# Assemble the file "NAME.s" with command line options OPTS and 386# compare the assembler standard error output against the regular 387# expressions given in the file "NAME.l". If TESTNAME is provided, 388# it will be used as the name of the test. 389 390proc run_list_test { name {opts {}} {testname {}} } { 391 global srcdir subdir 392 if { [string length $testname] == 0 } then { 393 set testname "[file tail $subdir] $name" 394 } 395 set file $srcdir/$subdir/$name 396 gas_run ${name}.s $opts ">&dump.out" 397 if { [regexp_diff "dump.out" "${file}.l"] } then { 398 fail $testname 399 verbose "output is [file_contents "dump.out"]" 2 400 return 401 } 402 pass $testname 403} 404 405# run_list_test_stdin NAME (optional): OPTS TESTNAME 406# 407# Similar to run_list_test, but use stdin as input. 408 409proc run_list_test_stdin { name {opts {}} {testname {}} } { 410 global srcdir subdir 411 if { [string length $testname] == 0 } then { 412 set testname "[file tail $subdir] $name" 413 } 414 set file $srcdir/$subdir/$name 415 gas_run_stdin ${name}.s $opts ">&dump.out" 416 if { [regexp_diff "dump.out" "${file}.l"] } then { 417 fail $testname 418 verbose "output is [file_contents "dump.out"]" 2 419 return 420 } 421 pass $testname 422} 423