1# Copyright 2004-2020 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, see <http://www.gnu.org/licenses/>. 15 16load_lib libgloss.exp 17 18# FIXME:brobecker/2004-03-31: 19# The following functions should eventually be part of dejagnu. Even after 20# these functions becomes available in dejagnu, we will keep for a while 21# a copy here in order to avoid increasing the dejagnu version 22# requirement. 23 24proc gdb_find_gnatmake {} { 25 global tool_root_dir 26 27 set root "$tool_root_dir/gcc" 28 set GM "" 29 30 if ![is_remote host] { 31 set file [lookfor_file $root gnatmake] 32 if { $file != "" } { 33 set GM "$file -I$root/ada/rts --GCC=$root/xgcc --GNATBIND=$root/gnatbind --GNATLINK=$root/gnatlink -cargs -B$root -largs --GCC=$root/xgcc -margs"; 34 } 35 } 36 37 if {$GM == ""} { 38 set GM [transform gnatmake] 39 } 40 41 return $GM 42} 43 44proc gdb_find_gdc {} { 45 global tool_root_dir 46 print "Tool Root: $tool_root_dir" 47 48 if {![is_remote host]} { 49 set file [lookfor_file $tool_root_dir gdc] 50 if { $file == "" } { 51 set file [lookfor_file $tool_root_dir gcc/gdc] 52 } 53 if { $file != "" } { 54 set CC "$file -B[file dirname $file]/" 55 } else { 56 set CC [transform gdc] 57 } 58 } else { 59 set CC [transform gdc] 60 } 61 print "CC: $CC" 62 return $CC 63} 64 65proc gdb_find_gfortran {} { 66 global tool_root_dir 67 68 if {![is_remote host]} { 69 set file [lookfor_file $tool_root_dir gfortran] 70 if { $file == "" } { 71 set file [lookfor_file $tool_root_dir gcc/gfortran] 72 } 73 if { $file != "" } { 74 set CC "$file -B[file dirname $file]/" 75 } else { 76 set CC [transform gfortran] 77 } 78 } else { 79 set CC [transform gfortran] 80 } 81 return $CC 82} 83 84proc gdb_find_go {} { 85 global tool_root_dir 86 87 set GO "" 88 89 if {![is_remote host]} { 90 set file [lookfor_file $tool_root_dir gccgo] 91 if { $file != "" } { 92 set root [file dirname $file] 93 set GO "$file -B$root/gcc/" 94 } 95 } 96 97 if { $GO == "" } { 98 set GO [transform gccgo] 99 } 100 101 return $GO 102} 103 104proc gdb_find_go_linker {} { 105 return [find_go] 106} 107 108proc gdb_find_rustc {} { 109 global tool_root_dir 110 if {![is_remote host]} { 111 set rustc [lookfor_file $tool_root_dir rustc] 112 if {$rustc == ""} { 113 set rustc rustc 114 } 115 } else { 116 set rustc "" 117 } 118 if {$rustc != ""} { 119 append rustc " --color never" 120 } 121 return $rustc 122} 123 124proc gdb_find_ldd {} { 125 global LDD_FOR_TARGET 126 if [info exists LDD_FOR_TARGET] { 127 set ldd $LDD_FOR_TARGET 128 } else { 129 set ldd "ldd" 130 } 131 return $ldd 132} 133 134proc gdb_find_objcopy {} { 135 global OBJCOPY_FOR_TARGET 136 if [info exists OBJCOPY_FOR_TARGET] { 137 set objcopy $OBJCOPY_FOR_TARGET 138 } else { 139 set objcopy [transform objcopy] 140 } 141 return $objcopy 142} 143 144# find target objdump 145proc gdb_find_objdump {} { 146 global OBJDUMP_FOR_TARGET 147 if [info exists OBJDUMP_FOR_TARGET] { 148 set objdump $OBJDUMP_FOR_TARGET 149 } else { 150 set objdump [transform objdump] 151 } 152 return $objdump 153} 154 155proc gdb_find_readelf {} { 156 global READELF_FOR_TARGET 157 if [info exists READELF_FOR_TARGET] { 158 set readelf $READELF_FOR_TARGET 159 } else { 160 set readelf [transform readelf] 161 } 162 return $readelf 163} 164 165proc gdb_find_eu-unstrip {} { 166 global EU_UNSTRIP_FOR_TARGET 167 if [info exists EU_UNSTRIP_FOR_TARGET] { 168 set eu_unstrip $EU_UNSTRIP_FOR_TARGET 169 } else { 170 set eu_unstrip [transform eu-unstrip] 171 } 172 return $eu_unstrip 173} 174 175# Local version of default_target_compile, to be used for languages that 176# dejagnu's default_target_compile doesn't support. 177proc gdb_default_target_compile_1 {source destfile type options} { 178 global target_triplet 179 global tool_root_dir 180 global CFLAGS_FOR_TARGET 181 global compiler_flags 182 183 if { $destfile == "" && $type != "preprocess" && $type != "none" } { 184 error "Must supply an output filename for the compile to default_target_compile" 185 } 186 187 set early_flags "" 188 set add_flags "" 189 set libs "" 190 set compiler_type "c" 191 set compiler "" 192 set linker "" 193 # linker_opts_order is one of "sources-then-flags", "flags-then-sources". 194 # The order matters for things like -Wl,--as-needed. The default is to 195 # preserve existing behavior. 196 set linker_opts_order "sources-then-flags" 197 set ldflags "" 198 set dest [target_info name] 199 200 if {[info exists CFLAGS_FOR_TARGET]} { 201 append add_flags " $CFLAGS_FOR_TARGET" 202 } 203 204 if {[info exists target_info(host,name)]} { 205 set host [host_info name] 206 } else { 207 set host "unix" 208 } 209 210 foreach i $options { 211 212 if { $i == "ada" } { 213 set compiler_type "ada" 214 if {[board_info $dest exists adaflags]} { 215 append add_flags " [target_info adaflags]" 216 } 217 if {[board_info $dest exists gnatmake]} { 218 set compiler [target_info gnatmake] 219 } else { 220 set compiler [find_gnatmake] 221 } 222 } 223 224 if { $i == "c++" } { 225 set compiler_type "c++" 226 if {[board_info $dest exists cxxflags]} { 227 append add_flags " [target_info cxxflags]" 228 } 229 append add_flags " [g++_include_flags]" 230 if {[board_info $dest exists c++compiler]} { 231 set compiler [target_info c++compiler] 232 } else { 233 set compiler [find_g++] 234 } 235 } 236 237 if { $i == "d" } { 238 set compiler_type "d" 239 if {[board_info $dest exists dflags]} { 240 append add_flags " [target_info dflags]" 241 } 242 if {[board_info $dest exists dcompiler]} { 243 set compiler [target_info dcompiler] 244 } else { 245 set compiler [find_gdc] 246 } 247 } 248 249 if { $i == "f77" } { 250 set compiler_type "f77" 251 if {[board_info $dest exists f77flags]} { 252 append add_flags " [target_info f77flags]" 253 } 254 if {[board_info $dest exists f77compiler]} { 255 set compiler [target_info f77compiler] 256 } else { 257 set compiler [find_g77] 258 } 259 } 260 261 if { $i == "f90" } { 262 set compiler_type "f90" 263 if {[board_info $dest exists f90flags]} { 264 append add_flags " [target_info f90flags]" 265 } 266 if {[board_info $dest exists f90compiler]} { 267 set compiler [target_info f90compiler] 268 } else { 269 set compiler [find_gfortran] 270 } 271 } 272 273 if { $i == "go" } { 274 set compiler_type "go" 275 if {[board_info $dest exists goflags]} { 276 append add_flags " [target_info goflags]" 277 } 278 if {[board_info $dest exists gocompiler]} { 279 set compiler [target_info gocompiler] 280 } else { 281 set compiler [find_go] 282 } 283 if {[board_info $dest exists golinker]} { 284 set linker [target_info golinker] 285 } else { 286 set linker [find_go_linker] 287 } 288 if {[board_info $dest exists golinker_opts_order]} { 289 set linker_opts_order [target_info golinker_opts_order] 290 } 291 } 292 293 if { $i == "rust" } { 294 set compiler_type "rust" 295 if {[board_info $dest exists rustflags]} { 296 append add_flags " [target_info rustflags]" 297 } 298 if {[board_info $dest exists rustflags]} { 299 set compiler [target_info rustflags] 300 } else { 301 set compiler [find_rustc] 302 } 303 } 304 305 if {[regexp "^dest=" $i]} { 306 regsub "^dest=" $i "" tmp 307 if {[board_info $tmp exists name]} { 308 set dest [board_info $tmp name] 309 } else { 310 set dest $tmp 311 } 312 } 313 if {[regexp "^compiler=" $i]} { 314 regsub "^compiler=" $i "" tmp 315 set compiler $tmp 316 } 317 if {[regexp "^early_flags=" $i]} { 318 regsub "^early_flags=" $i "" tmp 319 append early_flags " $tmp" 320 } 321 if {[regexp "^additional_flags=" $i]} { 322 regsub "^additional_flags=" $i "" tmp 323 append add_flags " $tmp" 324 } 325 if {[regexp "^ldflags=" $i]} { 326 regsub "^ldflags=" $i "" tmp 327 append ldflags " $tmp" 328 } 329 if {[regexp "^libs=" $i]} { 330 regsub "^libs=" $i "" tmp 331 append libs " $tmp" 332 } 333 if {[regexp "^incdir=" $i]} { 334 regsub "^incdir=" $i "-I" tmp 335 append add_flags " $tmp" 336 } 337 if {[regexp "^libdir=" $i]} { 338 regsub "^libdir=" $i "-L" tmp 339 append add_flags " $tmp" 340 } 341 if {[regexp "^ldscript=" $i]} { 342 regsub "^ldscript=" $i "" ldscript 343 } 344 if {[regexp "^redirect=" $i]} { 345 regsub "^redirect=" $i "" redirect 346 } 347 if {[regexp "^optimize=" $i]} { 348 regsub "^optimize=" $i "" optimize 349 } 350 if {[regexp "^timeout=" $i]} { 351 regsub "^timeout=" $i "" timeout 352 } 353 } 354 355 if {[board_info $host exists cflags_for_target]} { 356 append add_flags " [board_info $host cflags_for_target]" 357 } 358 359 global CC_FOR_TARGET 360 global CXX_FOR_TARGET 361 global D_FOR_TARGET 362 global F77_FOR_TARGET 363 global F90_FOR_TARGET 364 global GNATMAKE_FOR_TARGET 365 global GO_FOR_TARGET 366 global GO_LD_FOR_TARGET 367 global RUSTC_FOR_TARGET 368 369 if {[info exists GNATMAKE_FOR_TARGET]} { 370 if { $compiler_type == "ada" } { 371 set compiler $GNATMAKE_FOR_TARGET 372 } 373 } 374 375 if {[info exists CC_FOR_TARGET]} { 376 if { $compiler == "" } { 377 set compiler $CC_FOR_TARGET 378 } 379 } 380 381 if {[info exists CXX_FOR_TARGET]} { 382 if { $compiler_type == "c++" } { 383 set compiler $CXX_FOR_TARGET 384 } 385 } 386 387 if {[info exists D_FOR_TARGET]} { 388 if { $compiler_type == "d" } { 389 set compiler $D_FOR_TARGET 390 } 391 } 392 393 if {[info exists F77_FOR_TARGET]} { 394 if { $compiler_type == "f77" } { 395 set compiler $F77_FOR_TARGET 396 } 397 } 398 399 if {[info exists F90_FOR_TARGET]} { 400 if { $compiler_type == "f90" } { 401 set compiler $F90_FOR_TARGET 402 } 403 } 404 405 if { $compiler_type == "go" } { 406 if {[info exists GO_FOR_TARGET]} { 407 set compiler $GO_FOR_TARGET 408 } 409 if {[info exists GO_LD_FOR_TARGET]} { 410 set linker $GO_LD_FOR_TARGET 411 } 412 } 413 414 if {[info exists RUSTC_FOR_TARGET]} { 415 if {$compiler_type == "rust"} { 416 set compiler $RUSTC_FOR_TARGET 417 } 418 } 419 420 if { $type == "executable" && $linker != "" } { 421 set compiler $linker 422 } 423 424 if { $compiler == "" } { 425 set compiler [board_info $dest compiler] 426 if { $compiler == "" } { 427 return "default_target_compile: No compiler to compile with" 428 } 429 } 430 431 if {![is_remote host]} { 432 if { [which $compiler] == 0 } { 433 return "default_target_compile: Can't find $compiler." 434 } 435 } 436 437 if {$type == "object"} { 438 if {$compiler_type == "rust"} { 439 append add_flags "--emit obj" 440 } else { 441 append add_flags " -c" 442 } 443 } 444 445 if { $type == "preprocess" } { 446 append add_flags " -E" 447 } 448 449 if { $type == "assembly" } { 450 append add_flags " -S" 451 } 452 453 if {[board_info $dest exists cflags]} { 454 append add_flags " [board_info $dest cflags]" 455 } 456 457 if { $type == "executable" } { 458 if {[board_info $dest exists ldflags]} { 459 append add_flags " [board_info $dest ldflags]" 460 } 461 if { $compiler_type == "c++" } { 462 append add_flags " [g++_link_flags]" 463 } 464 if {[isnative]} { 465 # This is a lose. 466 catch "glob -nocomplain $tool_root_dir/libstdc++/libstdc++.so* $tool_root_dir/libstdc++/libstdc++.sl" tmp 467 if { ${tmp} != "" } { 468 if {[regexp ".*solaris2.*" $target_triplet]} { 469 # Solaris 2 470 append add_flags " -R$tool_root_dir/libstdc++" 471 } elseif {[regexp ".*(osf|irix5|linux).*" $target_triplet]} { 472 # OSF/1 or IRIX 5 473 append add_flags " -Wl,-rpath,$tool_root_dir/libstdc++" 474 } 475 } 476 } 477 } 478 479 if {![info exists ldscript]} { 480 set ldscript [board_info $dest ldscript] 481 } 482 483 foreach i $options { 484 if { $i == "debug" } { 485 if {[board_info $dest exists debug_flags]} { 486 append add_flags " [board_info $dest debug_flags]" 487 } else { 488 append add_flags " -g" 489 } 490 } 491 } 492 493 if {[info exists optimize]} { 494 append add_flags " $optimize" 495 } 496 497 if { $type == "executable" } { 498 append add_flags " $ldflags" 499 foreach x $libs { 500 if {[file exists $x]} { 501 append source " $x" 502 } else { 503 append add_flags " $x" 504 } 505 } 506 507 if {[board_info $dest exists libs]} { 508 append add_flags " [board_info $dest libs]" 509 } 510 511 # This probably isn't such a good idea, but it avoids nasty 512 # hackiness in the testsuites. 513 # The math library must be linked in before the C library. The C 514 # library is linked in by the linker script, so this must be before 515 # the linker script. 516 if {[board_info $dest exists mathlib]} { 517 append add_flags " [board_info $dest mathlib]" 518 } else { 519 append add_flags " -lm" 520 } 521 522 # This must be added here. 523 append add_flags " $ldscript" 524 525 if {[board_info $dest exists remote_link]} { 526 # Relink option. 527 append add_flags " -Wl,-r" 528 } 529 if {[board_info $dest exists output_format]} { 530 append add_flags " -Wl,-oformat,[board_info $dest output_format]" 531 } 532 } 533 534 if {[board_info $dest exists multilib_flags]} { 535 append add_flags " [board_info $dest multilib_flags]" 536 } 537 538 verbose "doing compile" 539 540 set sources "" 541 if {[is_remote host]} { 542 foreach x $source { 543 set file [remote_download host $x] 544 if { $file == "" } { 545 warning "Unable to download $x to host." 546 return "Unable to download $x to host." 547 } else { 548 append sources " $file" 549 } 550 } 551 } else { 552 set sources $source 553 } 554 555 if {[is_remote host]} { 556 append add_flags " -o " [file tail $destfile] 557 remote_file host delete [file tail $destfile] 558 } else { 559 if { $destfile != "" } { 560 append add_flags " -o $destfile" 561 } 562 } 563 564 # This is obscure: we put SOURCES at the end when building an 565 # object, because otherwise, in some situations, libtool will 566 # become confused about the name of the actual source file. 567 switch $type { 568 "object" { 569 set opts "$early_flags $add_flags $sources" 570 } 571 "executable" { 572 switch $linker_opts_order { 573 "flags-then-sources" { 574 set opts "$early_flags $add_flags $sources" 575 } 576 "sources-then-flags" { 577 set opts "$early_flags $sources $add_flags" 578 } 579 default { 580 error "Invalid value for board_info linker_opts_order" 581 } 582 } 583 } 584 default { 585 set opts "$early_flags $sources $add_flags" 586 } 587 } 588 589 if {[is_remote host]} { 590 if {[host_info exists use_at]} { 591 set fid [open "atfile" "w"] 592 puts $fid "$opts" 593 close $fid 594 set opts "@[remote_download host atfile]" 595 remote_file build delete atfile 596 } 597 } 598 599 verbose "Invoking the compiler as $compiler $opts" 2 600 601 if {[info exists redirect]} { 602 verbose "Redirecting output to $redirect" 2 603 set status [remote_exec host "$compiler $opts" "" "" $redirect] 604 } else { 605 if {[info exists timeout]} { 606 verbose "Setting timeout to $timeout" 2 607 set status [remote_exec host "$compiler $opts" "" "" "" $timeout] 608 } else { 609 set status [remote_exec host "$compiler $opts"] 610 } 611 } 612 613 set compiler_flags $opts 614 if {[is_remote host]} { 615 remote_upload host [file tail $destfile] $destfile 616 remote_file host delete [file tail $destfile] 617 } 618 set comp_output [prune_warnings [lindex $status 1]] 619 regsub "^\[\r\n\]+" $comp_output "" comp_output 620 if { [lindex $status 0] != 0 } { 621 verbose -log "compiler exited with status [lindex $status 0]" 622 } 623 if { [lindex $status 1] != "" } { 624 verbose -log "output is:\n[lindex $status 1]" 2 625 } 626 if { [lindex $status 0] != 0 && "${comp_output}" == "" } { 627 set comp_output "exit status is [lindex $status 0]" 628 } 629 return ${comp_output} 630} 631 632# If dejagnu's default_target_compile supports the language specified in 633# OPTIONS, use it. Otherwise, use gdb_default_target_compile_1. 634proc gdb_default_target_compile {source destfile type options} { 635 global use_gdb_compile 636 637 set need_local_lang 0 638 set need_local_early_flags 0 639 foreach i $options { 640 641 if { $i == "ada" || $i == "d" || $i == "go" || $i == "rust" } { 642 set need_local_lang [info exists use_gdb_compile($i)] 643 } 644 645 if { $i == "c++" } { 646 set need_local_lang 0 647 } 648 649 if { $i == "f77" || $i == "f90" } { 650 set need_local_lang [info exists use_gdb_compile(fortran)] 651 } 652 653 if { [regexp "^early_flags=" $i] } { 654 set need_local_early_flags 1 655 } 656 } 657 658 if { $need_local_lang || $need_local_early_flags } { 659 return [gdb_default_target_compile_1 $source $destfile $type $options] 660 } 661 662 return [dejagnu_default_target_compile $source $destfile $type $options] 663} 664 665# Array of languages for which dejagnu's default_target_compile is missing 666# support. 667array set use_gdb_compile [list] 668 669# Note missing support in dejagnu's default_target_compile. This 670# needs to be fixed by porting the missing support to Dejagnu. 671set note_prefix "Dejagnu's default_target_compile is missing support for " 672set note_suffix ", using local override" 673 674if {[info procs find_gnatmake] == ""} { 675 rename gdb_find_gnatmake find_gnatmake 676 set use_gdb_compile(ada) 1 677 gdb_note [join [list $note_prefix "Ada" $note_suffix] ""] 678} 679 680if {[info procs find_gfortran] == ""} { 681 rename gdb_find_gfortran find_gfortran 682 set use_gdb_compile(fortran) 1 683 gdb_note [join [list $note_prefix "Fortran" $note_suffix] ""] 684} 685 686if {[info procs find_go_linker] == ""} { 687 rename gdb_find_go find_go 688 rename gdb_find_go_linker find_go_linker 689 set use_gdb_compile(go) 1 690 gdb_note [join [list $note_prefix "Go" $note_suffix] ""] 691} 692 693if {[info procs find_gdc] == ""} { 694 rename gdb_find_gdc find_gdc 695 set use_gdb_compile(d) 1 696 gdb_note [join [list $note_prefix "D" $note_suffix] ""] 697} 698 699if {[info procs find_rustc] == ""} { 700 rename gdb_find_rustc find_rustc 701 set use_gdb_compile(rust) 1 702 gdb_note [join [list $note_prefix "Rust" $note_suffix] ""] 703} 704 705# If dejagnu's default_target_compile is missing support for any language, 706# override it. 707if { [array size use_gdb_compile] != 0 } { 708 catch {rename default_target_compile dejagnu_default_target_compile} 709 rename gdb_default_target_compile default_target_compile 710} 711 712 713# Provide 'lreverse' missing in Tcl before 7.5. 714 715if {[info procs lreverse] == ""} { 716 proc lreverse { arg } { 717 set retval {} 718 while { [llength $retval] < [llength $arg] } { 719 lappend retval [lindex $arg end-[llength $retval]] 720 } 721 return $retval 722 } 723} 724 725# Various ccache versions provide incorrect debug info such as ignoring 726# different current directory, breaking GDB testsuite. 727set env(CCACHE_DISABLE) 1 728unset -nocomplain env(CCACHE_NODISABLE) 729