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