1# Copyright 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003, 2004, 2006 2# Free Software Foundation, Inc. 3 4# This program is free software; you can redistribute it and/or modify 5# it under the terms of the GNU General Public License as published by 6# the Free Software Foundation; either version 2 of the License, or 7# (at your option) any later version. 8# 9# This program is distributed in the hope that it will be useful, 10# but WITHOUT ANY WARRANTY; without even the implied warranty of 11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12# GNU General Public License for more details. 13# 14# You should have received a copy of the GNU General Public License 15# along with this program; if not, write to the Free Software 16# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. 17 18# Please email any bugs, comments, and/or additions to this file to: 19# bug-dejagnu@prep.ai.mit.edu 20 21# This file was written by Rob Savoye <rob@cygnus.com> 22# and extended by Ian Lance Taylor <ian@cygnus.com> 23 24proc binutil_version { prog } { 25 if ![is_remote host] { 26 set path [which $prog] 27 if {$path == 0} then { 28 perror "$prog can't be run, file not found." 29 return "" 30 } 31 } else { 32 set path $prog 33 } 34 set state [remote_exec host $prog --version] 35 set tmp "[lindex $state 1]\n" 36 # Should find a way to discard constant parts, keep whatever's 37 # left, so the version string could be almost anything at all... 38 regexp "\[^\n\]* (cygnus-|)(\[-0-9.a-zA-Z-\]+)\[\r\n\].*" "$tmp" version cyg number 39 if ![info exists number] then { 40 return "$path (no version number)\n" 41 } 42 return "$path $number\n" 43} 44 45# 46# default_binutils_run 47# run a program, returning the output 48# sets binutils_run_failed if the program does not exist 49# 50proc default_binutils_run { prog progargs } { 51 global binutils_run_failed 52 global host_triplet 53 54 set binutils_run_failed 0 55 56 if ![is_remote host] { 57 if {[which $prog] == 0} then { 58 perror "$prog does not exist" 59 set binutils_run_failed 1 60 return "" 61 } 62 } 63 64 send_log "$prog $progargs\n" 65 verbose "$prog $progargs" 66 67 # Gotta quote dollar-signs because they get mangled by the 68 # shell otherwise. 69 regsub -all "\\$" "$progargs" "\\$" progargs 70 71 set state [remote_exec host $prog $progargs] 72 set exec_output [prune_warnings [lindex $state 1]] 73 if {![string match "" $exec_output]} then { 74 send_log "$exec_output\n" 75 verbose "$exec_output" 76 } else { 77 if { [lindex $state 0] != 0 } { 78 set exec_output "$prog exited with status [lindex $state 0]" 79 send_log "$exec_output\n" 80 verbose "$exec_output" 81 } 82 } 83 return $exec_output 84} 85 86# 87# default_binutils_assemble 88# assemble a file 89# 90proc default_binutils_assemble { source object } { 91 global srcdir 92 global host_triplet 93 94 # The HPPA assembler syntax is a little different than most, to make 95 # the test source file assemble we need to run it through sed. 96 # 97 # This is a hack in that it won't scale well if other targets need 98 # similar transformations to assemble. We'll generalize the hack 99 # if/when other targets need similar handling. 100 if { [istarget "hppa*-*-*"] && ![istarget "*-*-linux*" ] } then { 101 set sed_file $srcdir/config/hppa.sed 102 send_log "sed -f $sed_file < $source > asm.s\n" 103 verbose "sed -f $sed_file < $source > asm.s" 104 catch "exec sed -f $sed_file < $source > asm.s" 105 set source asm.s 106 } 107 108 set exec_output [target_assemble $source $object ""] 109 set exec_output [prune_warnings $exec_output] 110 111 if [string match "" $exec_output] { 112 return 1 113 } else { 114 send_log "$exec_output\n" 115 verbose "$exec_output" 116 perror "$source: assembly failed" 117 return 0 118 } 119} 120 121# 122# is_elf_format 123# true if the object format is known to be ELF 124# 125proc is_elf_format {} { 126 if { ![istarget *-*-sysv4*] \ 127 && ![istarget *-*-unixware*] \ 128 && ![istarget *-*-elf*] \ 129 && ![istarget *-*-eabi*] \ 130 && ![istarget hppa*64*-*-hpux*] \ 131 && ![istarget ia64-*-hpux*] \ 132 && ![istarget *-*-linux*] \ 133 && ![istarget *-*-irix5*] \ 134 && ![istarget *-*-irix6*] \ 135 && ![istarget *-*-netbsd*] \ 136 && ![istarget *-*-solaris2*] } { 137 return 0 138 } 139 140 if { [istarget *-*-linux*aout*] \ 141 || [istarget *-*-linux*oldld*] } { 142 return 0 143 } 144 145 if { ![istarget *-*-netbsdelf*] \ 146 && ([istarget *-*-netbsd*aout*] \ 147 || [istarget *-*-netbsdpe*] \ 148 || [istarget arm*-*-netbsd*] \ 149 || [istarget sparc-*-netbsd*] \ 150 || [istarget i*86-*-netbsd*] \ 151 || [istarget m68*-*-netbsd*] \ 152 || [istarget vax-*-netbsd*] \ 153 || [istarget ns32k-*-netbsd*]) } { 154 return 0 155 } 156 return 1 157} 158 159# 160# exe_ext 161# Returns target executable extension, if any. 162# 163proc exe_ext {} { 164 if { [istarget *-*-mingw*] || [istarget *-*-cygwin*] } { 165 return ".exe" 166 } else { 167 return "" 168 } 169} 170 171# Copied and modified from gas. 172 173# run_dump_test FILE (optional:) EXTRA_OPTIONS 174# 175# Assemble a .s file, then run some utility on it and check the output. 176# 177# There should be an assembly language file named FILE.s in the test 178# suite directory, and a pattern file called FILE.d. `run_dump_test' 179# will assemble FILE.s, run some tool like `objdump', `objcopy', or 180# `nm' on the .o file to produce textual output, and then analyze that 181# with regexps. The FILE.d file specifies what program to run, and 182# what to expect in its output. 183# 184# The FILE.d file begins with zero or more option lines, which specify 185# flags to pass to the assembler, the program to run to dump the 186# assembler's output, and the options it wants. The option lines have 187# the syntax: 188# 189# # OPTION: VALUE 190# 191# OPTION is the name of some option, like "name" or "objdump", and 192# VALUE is OPTION's value. The valid options are described below. 193# Whitespace is ignored everywhere, except within VALUE. The option 194# list ends with the first line that doesn't match the above syntax. 195# However, a line within the options that begins with a #, but doesn't 196# have a recognizable option name followed by a colon, is considered a 197# comment and entirely ignored. 198# 199# The optional EXTRA_OPTIONS argument to `run_dump_test' is a list of 200# two-element lists. The first element of each is an option name, and 201# the second additional arguments to be added on to the end of the 202# option list as given in FILE.d. (If omitted, no additional options 203# are added.) 204# 205# The interesting options are: 206# 207# name: TEST-NAME 208# The name of this test, passed to DejaGNU's `pass' and `fail' 209# commands. If omitted, this defaults to FILE, the root of the 210# .s and .d files' names. 211# 212# as: FLAGS 213# When assembling FILE.s, pass FLAGS to the assembler. 214# 215# PROG: PROGRAM-NAME 216# The name of the program to run to analyze the .o file produced 217# by the assembler. This can be omitted; run_dump_test will guess 218# which program to run by seeing which of the flags options below 219# is present. 220# 221# objdump: FLAGS 222# nm: FLAGS 223# objcopy: FLAGS 224# Use the specified program to analyze the .o file, and pass it 225# FLAGS, in addition to the .o file name. Note that they are run 226# with LC_ALL=C in the environment to give consistent sorting 227# of symbols. 228# 229# source: SOURCE 230# Assemble the file SOURCE.s. If omitted, this defaults to FILE.s. 231# This is useful if several .d files want to share a .s file. 232# 233# target: GLOBS... 234# Run this test only on a specified list of targets. More precisely, 235# each glob in the space-separated list is passed to "istarget"; if 236# it evaluates true for any of them, the test will be run, otherwise 237# it will be marked unsupported. 238# 239# not-target: GLOBS... 240# Do not run this test on a specified list of targets. Again, 241# the each glob in the space-separated list is passed to 242# "istarget", and the test is run if it evaluates *false* for 243# *all* of them. Otherwise it will be marked unsupported. 244# 245# skip: GLOBS... 246# not-skip: GLOBS... 247# These are exactly the same as "not-target" and "target", 248# respectively, except that they do nothing at all if the check 249# fails. They should only be used in groups, to construct a single 250# test which is run on all targets but with variant options or 251# expected output on some targets. (For example, see 252# gas/arm/inst.d and gas/arm/wince_inst.d.) 253# 254# error: REGEX 255# An error with message matching REGEX must be emitted for the test 256# to pass. The PROG, objdump, nm and objcopy options have no 257# meaning and need not supplied if this is present. 258# 259# warning: REGEX 260# Expect a gas warning matching REGEX. It is an error to issue 261# both "error" and "warning". 262# 263# stderr: FILE 264# FILE contains regexp lines to be matched against the diagnostic 265# output of the assembler. This does not preclude the use of 266# PROG, nm, objdump, or objcopy. 267# 268# error-output: FILE 269# Means the same as 'stderr', but also indicates that the assembler 270# is expected to exit unsuccessfully (therefore PROG, objdump, nm, 271# and objcopy have no meaning and should not be supplied). 272# 273# Each option may occur at most once. 274# 275# After the option lines come regexp lines. `run_dump_test' calls 276# `regexp_diff' to compare the output of the dumping tool against the 277# regexps in FILE.d. `regexp_diff' is defined later in this file; see 278# further comments there. 279 280proc run_dump_test { name {extra_options {}} } { 281 global subdir srcdir 282 global OBJDUMP NM OBJCOPY READELF STRIP 283 global OBJDUMPFLAGS NMFLAGS OBJCOPYFLAGS READELFFLAGS STRIPFLAGS 284 global host_triplet 285 global env 286 global copyfile 287 global tempfile 288 289 if [string match "*/*" $name] { 290 set file $name 291 set name [file tail $name] 292 } else { 293 set file "$srcdir/$subdir/$name" 294 } 295 set opt_array [slurp_options "${file}.d"] 296 if { $opt_array == -1 } { 297 perror "error reading options from $file.d" 298 unresolved $subdir/$name 299 return 300 } 301 set opts(addr2line) {} 302 set opts(ar) {} 303 set opts(nm) {} 304 set opts(objcopy) {} 305 set opts(objdump) {} 306 set opts(strip) {} 307 set opts(ranlib) {} 308 set opts(readelf) {} 309 set opts(size) {} 310 set opts(strings) {} 311 set opts(name) {} 312 set opts(PROG) {} 313 set opts(DUMPPROG) {} 314 set opts(source) {} 315 set opts(target) {} 316 set opts(not-target) {} 317 set opts(skip) {} 318 set opts(not-skip) {} 319 320 foreach i $opt_array { 321 set opt_name [lindex $i 0] 322 set opt_val [lindex $i 1] 323 if ![info exists opts($opt_name)] { 324 perror "unknown option $opt_name in file $file.d" 325 unresolved $subdir/$name 326 return 327 } 328 if [string length $opts($opt_name)] { 329 perror "option $opt_name multiply set in $file.d" 330 unresolved $subdir/$name 331 return 332 } 333 set opts($opt_name) $opt_val 334 } 335 336 foreach i $extra_options { 337 set opt_name [lindex $i 0] 338 set opt_val [lindex $i 1] 339 if ![info exists opts($opt_name)] { 340 perror "unknown option $opt_name given in extra_opts" 341 unresolved $subdir/$name 342 return 343 } 344 # add extra option to end of existing option, adding space 345 # if necessary. 346 if [string length $opts($opt_name)] { 347 append opts($opt_name) " " 348 } 349 append opts($opt_name) $opt_val 350 } 351 352 if { $opts(name) == "" } { 353 set testname "$subdir/$name" 354 } else { 355 set testname $opts(name) 356 } 357 verbose "Testing $testname" 358 359 if {$opts(PROG) == ""} { 360 perror "program isn't set in $file.d" 361 unresolved $testname 362 return 363 } 364 365 set destopt "" 366 switch -- $opts(PROG) { 367 ar { set program ar } 368 objcopy { set program objcopy } 369 ranlib { set program ranlib } 370 strip { 371 set program strip 372 set destopt "-o" 373 } 374 strings { set program strings } 375 default { 376 perror "unrecognized program option $opts(PROG) in $file.d" 377 unresolved $testname 378 return } 379 } 380 381 set dumpprogram "" 382 if { $opts(DUMPPROG) != "" } { 383 switch -- $opts(DUMPPROG) { 384 addr2line { set dumpprogram addr2line } 385 nm { set dumpprogram nm } 386 objdump { set dumpprogram objdump } 387 readelf { set dumpprogram readelf } 388 size { set dumpprogram size } 389 default { 390 perror "unrecognized dump program option $opts(DUMPPROG) in $file.d" 391 unresolved $testname 392 return } 393 } 394 } else { 395 # Guess which program to run, by seeing which option was specified. 396 foreach p {objdump nm readelf} { 397 if {$opts($p) != ""} { 398 if {$dumpprogram != ""} { 399 perror "ambiguous dump program in $file.d" 400 unresolved $testname 401 return 402 } else { 403 set dumpprogram $p 404 } 405 } 406 } 407 } 408 409 # Handle skipping the test on specified targets. 410 # You can have both skip/not-skip and target/not-target, but you can't 411 # have both skip and not-skip, or target and not-target, in the same file. 412 if { $opts(skip) != "" } then { 413 if { $opts(not-skip) != "" } then { 414 perror "$testname: mixing skip and not-skip directives is invalid" 415 unresolved $testname 416 return 417 } 418 foreach glob $opts(skip) { 419 if {[istarget $glob]} { return } 420 } 421 } 422 if { $opts(not-skip) != "" } then { 423 set skip 1 424 foreach glob $opts(not-skip) { 425 if {[istarget $glob]} { 426 set skip 0 427 break 428 } 429 } 430 if {$skip} { return } 431 } 432 if { $opts(target) != "" } then { 433 if { $opts(not-target) != "" } then { 434 perror "$testname: mixing target and not-target directives is invalid" 435 unresolved $testname 436 return 437 } 438 set skip 1 439 foreach glob $opts(target) { 440 if {[istarget $glob]} { 441 set skip 0 442 break 443 } 444 } 445 if {$skip} { 446 unsupported $testname 447 return 448 } 449 } 450 if { $opts(not-target) != "" } then { 451 foreach glob $opts(not-target) { 452 if {[istarget $glob]} { 453 unsupported $testname 454 return 455 } 456 } 457 } 458 459 if { $opts(source) == "" } { 460 set srcfile ${file}.s 461 } else { 462 set srcfile $srcdir/$subdir/$opts(source) 463 } 464 465 set exec_output [binutils_assemble ${srcfile} tmpdir/bintest.o] 466 if [string match "" $exec_output] then { 467 send_log "$exec_output\n" 468 verbose "$exec_output" 469 fail $testname 470 return 471 } 472 473 set progopts1 $opts($program) 474 eval set progopts \$[string toupper $program]FLAGS 475 eval set binary \$[string toupper $program] 476 477 set exec_output [binutils_run $binary "$progopts $progopts1 $tempfile $destopt ${copyfile}.o"] 478 if ![string match "" $exec_output] { 479 send_log "$exec_output\n" 480 verbose "$exec_output" 481 fail $testname 482 return 483 } 484 485 set progopts1 $opts($dumpprogram) 486 eval set progopts \$[string toupper $dumpprogram]FLAGS 487 eval set binary \$[string toupper $dumpprogram] 488 489 if { [which $binary] == 0 } { 490 untested $testname 491 return 492 } 493 494 verbose "running $binary $progopts $progopts1" 3 495 496 set cmd "$binary $progopts $progopts1 ${copyfile}.o > tmpdir/dump.out" 497 498 # Ensure consistent sorting of symbols 499 if {[info exists env(LC_ALL)]} { 500 set old_lc_all $env(LC_ALL) 501 } 502 set env(LC_ALL) "C" 503 send_log "$cmd\n" 504 catch "exec $cmd" comp_output 505 if {[info exists old_lc_all]} { 506 set env(LC_ALL) $old_lc_all 507 } else { 508 unset env(LC_ALL) 509 } 510 set comp_output [prune_warnings $comp_output] 511 if ![string match "" $comp_output] then { 512 send_log "$comp_output\n" 513 fail $testname 514 return 515 } 516 517 verbose_eval {[file_contents "tmpdir/dump.out"]} 3 518 if { [regexp_diff "tmpdir/dump.out" "${file}.d"] } then { 519 fail $testname 520 verbose "output is [file_contents "tmpdir/dump.out"]" 2 521 return 522 } 523 524 pass $testname 525} 526 527proc slurp_options { file } { 528 if [catch { set f [open $file r] } x] { 529 #perror "couldn't open `$file': $x" 530 perror "$x" 531 return -1 532 } 533 set opt_array {} 534 # whitespace expression 535 set ws {[ ]*} 536 set nws {[^ ]*} 537 # whitespace is ignored anywhere except within the options list; 538 # option names are alphabetic plus dash 539 set pat "^#${ws}(\[a-zA-Z-\]*)$ws:${ws}(.*)$ws\$" 540 while { [gets $f line] != -1 } { 541 set line [string trim $line] 542 # Whitespace here is space-tab. 543 if [regexp $pat $line xxx opt_name opt_val] { 544 # match! 545 lappend opt_array [list $opt_name $opt_val] 546 } elseif {![regexp "^#" $line ]} { 547 break 548 } 549 } 550 close $f 551 return $opt_array 552} 553 554# regexp_diff, based on simple_diff taken from ld test suite 555# compares two files line-by-line 556# file1 contains strings, file2 contains regexps and #-comments 557# blank lines are ignored in either file 558# returns non-zero if differences exist 559# 560proc regexp_diff { file_1 file_2 } { 561 562 set eof -1 563 set end_1 0 564 set end_2 0 565 set differences 0 566 set diff_pass 0 567 568 if [file exists $file_1] then { 569 set file_a [open $file_1 r] 570 } else { 571 perror "$file_1 doesn't exist" 572 return 1 573 } 574 575 if [file exists $file_2] then { 576 set file_b [open $file_2 r] 577 } else { 578 perror "$file_2 doesn't exist" 579 close $file_a 580 return 1 581 } 582 583 verbose " Regexp-diff'ing: $file_1 $file_2" 2 584 585 while { 1 } { 586 set line_a "" 587 set line_b "" 588 while { [string length $line_a] == 0 } { 589 if { [gets $file_a line_a] == $eof } { 590 set end_1 1 591 break 592 } 593 } 594 while { [string length $line_b] == 0 || [string match "#*" $line_b] } { 595 if [ string match "#pass" $line_b ] { 596 set end_2 1 597 set diff_pass 1 598 break 599 } elseif [ string match "#..." $line_b ] { 600 if { [gets $file_b line_b] == $eof } { 601 set end_2 1 602 set diff_pass 1 603 break 604 } 605 verbose "looking for \"^$line_b$\"" 3 606 while { ![regexp "^$line_b$" "$line_a"] } { 607 verbose "skipping \"$line_a\"" 3 608 if { [gets $file_a line_a] == $eof } { 609 set end_1 1 610 break 611 } 612 } 613 break 614 } 615 if { [gets $file_b line_b] == $eof } { 616 set end_2 1 617 break 618 } 619 } 620 621 if { $diff_pass } { 622 break 623 } elseif { $end_1 && $end_2 } { 624 break 625 } elseif { $end_1 } { 626 send_log "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1\n" 627 verbose "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1" 3 628 set differences 1 629 break 630 } elseif { $end_2 } { 631 send_log "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n" 632 verbose "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n" 3 633 set differences 1 634 break 635 } else { 636 verbose "regexp \"^$line_b$\"\nline \"$line_a\"" 3 637 if ![regexp "^$line_b$" "$line_a"] { 638 send_log "regexp_diff match failure\n" 639 send_log "regexp \"^$line_b$\"\nline \"$line_a\"\n" 640 verbose "regexp_diff match failure\n" 3 641 set differences 1 642 } 643 } 644 } 645 646 if { $differences == 0 && !$diff_pass && [eof $file_a] != [eof $file_b] } { 647 send_log "$file_1 and $file_2 are different lengths\n" 648 verbose "$file_1 and $file_2 are different lengths" 3 649 set differences 1 650 } 651 652 close $file_a 653 close $file_b 654 655 return $differences 656} 657 658proc file_contents { filename } { 659 set file [open $filename r] 660 set contents [read $file] 661 close $file 662 return $contents 663} 664 665proc verbose_eval { expr { level 1 } } { 666 global verbose 667 if $verbose>$level then { eval verbose "$expr" $level } 668} 669