TheRock/debug-tools/rocgdb/source/gdb/testsuite/lib/rocm.exp

# Copyright (C) 2019-2024 Free Software Foundation, Inc.
# Copyright (C) 2019-2024 Advanced Micro Devices, Inc. All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# Support library for testing ROCm (AMD GPU) GDB features.

# tclint-disable redefined-builtin

# ROCM_PATH is used by the HIP toolchain.
if {[info exists ::env(ROCM_PATH)]} {
    set rocm_path $::env(ROCM_PATH)
} else {
    set rocm_path "/opt/rocm"
}

# Act as a drop-in replacement for "remote_exec host"
# that logs the failures.

proc log_host_exec { cmd } {
    set result [remote_exec host "$cmd"]
    set exit_status [lindex $result 0]
    if {$exit_status != 0} {
	# -1 indicates that $cmd could not be executed at all.
	if {$exit_status == -1} {
	    verbose -log "Cannot execute $cmd."
	} else {
	    verbose -log "$cmd returned an error."
	}
    }

    return $result
}

# Detect available GPU devices.
#
# Return a list of GPU devices that do exist on the system.
# The list will be empty when there's no GPU or the execution
# of the enumerator program does not succeed.  It is up to the
# caller of this procedure what should happen when an empty
# list is returned.

gdb_caching_proc find_amdgpu_devices {} {
    # Compile and run a simple custom HIP program that lists all GPU
    # devices, one device per line.  We don't rely on
    # rocm_agent_enumerator because that does not exist on all
    # supported platforms.
    #
    # Compile without --offload-arch (which is fine because this is a
    # host-only program), because otherwise gdb_compile would call
    # hcc_amdgpu_targets to know which --offload-arch flags to pass to
    # the HIP compiler, and we'd end up here again, resulting in
    # infinite recursion.
    set options {hip hip_no_offload_arch}
    if {![gdb_simple_compile device_enumerator {
	    #include <hip/hip_runtime.h>
	    #include <stdio.h>
	    #include <string.h>

	    int
	    main ()
	    {
	      int device_count;
	      if (hipGetDeviceCount (&device_count) == hipSuccess)
		for (int i = 0; i < device_count; i++)
		  {
		    hipDeviceProp_t props;
		    if (hipGetDeviceProperties (&props, i) == hipSuccess)
		      {
			/* Strip out the supported features list,
			   like gfx90a:sramecc+:xnack-.  */
			char *colon = strstr (props.gcnArchName, ":");
			if (colon != nullptr)
			  *colon = '\0';
			printf ("%s\n", props.gcnArchName);
		      }
		  }
	    }
	} executable $options]} {
	return {}
    }

    set result [log_host_exec "$obj"]
    if {[lindex $result 0] == 0} {
	set targets [lindex $result 1]
	# Convert newline-separated string to a list.
	return [list {*}$targets]
    }

    return {}
}

# Get the list of unique GPU targets to compile for.
#
# If HCC_AMDGPU_TARGET is set in the environment, use it.
# Otherwise, consider the devices available on the system.
#
# Duplicates are removed so that systems with multiple identical
# GPUs do not produce redundant --offload-arch flags.

proc hcc_amdgpu_targets {} {
    # First, look for HCC_AMDGPU_TARGET (same env var the HIP toolchain uses).
    if {[info exists ::env(HCC_AMDGPU_TARGET)]} {
	# We don't verify the contents of HCC_AMDGPU_TARGET.
	# That's the toolchain's job.
	set targets [split $::env(HCC_AMDGPU_TARGET) ","]
    } else {
	set targets [find_amdgpu_devices]
    }

    # Remove duplicates while preserving order.
    array set seen {}
    set unique {}
    foreach t $targets {
	if {![info exists seen($t)]} {
	    set seen($t) 1
	    lappend unique $t
	}
    }
    return $unique
}

gdb_caching_proc allow_hip_tests {} {
    # Only the native target supports ROCm debugging.  E.g., when
    # testing against GDBserver, there's no point in running the ROCm
    # tests.
    if {[target_info gdb_protocol] != ""} {
	return {0 "remote debugging"}
    }

    # Check a hardcoded set of targets as an optimization, so that we
    # save one external program invocation (of 'GDB --configuration')
    # when GDB is not configured with amd-dbgapi support.  External
    # program invocations have a non-negligible time cost on Windows.
    if {![istarget "*-linux*"] && ![istarget "*-mingw*"]} {
	return {0 "target platform is not supported"}
    }

    # Ensure that GDB is built with amd-dbgapi support.
    set output [remote_exec host $::GDB "$::INTERNAL_GDBFLAGS --configuration"]
    if { [string first "--with-amd-dbgapi" $output] == -1 } {
	return {0 "amd-dbgapi not supported"}
    }

    # Check if there's any GPU device to run the tests on.  If this
    # works, then we also know we have a working HIP compiler
    # available.
    set devices [find_amdgpu_devices]
    if {[llength $devices] == 0} {
	return {0 "no suitable amdgpu targets found"}
    }

    return 1
}

# Return true if GPU core dump tests are allowed.

gdb_caching_proc allow_rocm_core_tests {} {
    if {[istarget "*-mingw*"]} {
	# GPU core dumps are not supported on Windows, neither runtime
	# cores, nor with GDB's gcore command.
	return 0
    }

    return 1
}

# Check whether any of the given flag patterns appear in
# GDB_TESTCASE_OPTIONS, CFLAGS_FOR_TARGET or CXXFLAGS_FOR_TARGET.
# Each pattern is matched as a regular expression anchored against a
# whole whitespace-separated token, so a single pattern can match a
# family of flags: e.g. "-flto(=.*)?" matches both "-flto" and
# "-flto=thin", while "-O2" still matches only "-O2" (not "-O20").
# Usage example: check_for_any_flags {-flto(=.*)? -O[1-9]}

proc check_for_any_flags {flags} {
    global GDB_TESTCASE_OPTIONS CFLAGS_FOR_TARGET CXXFLAGS_FOR_TARGET

    if {[llength $flags] == 0} {
	return 0
    }

    # Sources of compile flags to check, in order:
    #   - GDB_TESTCASE_OPTIONS (the standard testsuite override).
    #   - CFLAGS_FOR_TARGET / CXXFLAGS_FOR_TARGET, in case the
    #     caller injects optimization flags that way instead.
    # These arrive as Tcl globals when set on the runtest command
    # line; each is read only when present (see "info exists" below).
    set sources [list]
    foreach var {GDB_TESTCASE_OPTIONS CFLAGS_FOR_TARGET CXXFLAGS_FOR_TARGET} {
	if {[info exists $var]} {
	    set val [set $var]
	    if {$val ne ""} {
		lappend sources $val
	    }
	}
    }

    foreach src $sources {
	# Split on whitespace so each flag is matched on its own; the
	# anchored regexp below then keeps matching to a whole token
	# (e.g. "-O2" does not match inside "-O20").
	foreach tok [split $src] {
	    foreach pat $flags {
		if {[regexp -- "^(?:$pat)\$" $tok]} {
		    return 1
		}
	    }
	}
    }

    return 0
}

# Predicate that succeeds (returns 1) when no optimization flag is in
# effect, and fails (returns 0) when one is present.  Any -O level
# other than -O0 enables optimization (a bare -O means -O1).  Use with
# "require no_optimized_code" to gate tests that are not meaningful
# under optimization.

gdb_caching_proc no_optimized_code {} {
    if {[check_for_any_flags {-O([1-9][0-9]*|fast|s|z|g)?}]} {
	verbose -log "Optimization flags are present."
	return 0
    }
    return 1
}

# Predicate that succeeds (returns 1) when -flto is not in effect,
# and fails (returns 0) when it is.  Matches -flto as well as its
# moded forms (e.g. -flto=thin, -flto=full).  Use with "require
# no_lto" to gate tests that are not meaningful under link-time
# optimization.

gdb_caching_proc no_lto {} {
    if {[check_for_any_flags {-flto(=.*)?}]} {
	verbose -log "Link-time optimization flags are present."
	return 0
    }
    return 1
}

# The empty host object put in bundles when compiling assembly files.
# As a speed optimization, avoid recompiling it over and over for each
# testcase program.
global gdb_saved_hip_empty_host_obj
set gdb_saved_hip_empty_host_obj ""

# Assemble SOURCE and put the resulting object in an offload bundle at
# DEST.  OPTIONS are regular gdb_compile options.

proc rocm_assemble {source dest {options ""}} {
    global objdir

    # Pick the first target as the default one.
    # The list can't be empty.  Else, allow_hip_tests would've caught it.
    set gpu_target [lindex [hcc_amdgpu_targets] 0]

    global rocm_path
    global gdb_saved_hip_empty_host_obj

    set asm_options "early_flags=-O0\
				 -target amdgcn-amd-amdhsa\
				 -mcpu=$gpu_target -nogpulib\
				 -fno-autolink\
				 -faddrsig"
    lappend options "hip"
    lappend options $asm_options

    # Assemble the device side of the bundle.
    set tmp_o [standard_temp_file [file tail $dest].tmp.o]
    set res [gdb_compile $source $tmp_o object $options]
    if {$res != ""} {
	return $res
    }

    # Assemble an empty .o for the host side of the bundle.  Only do
    # it once as an optimization.
    if { $gdb_saved_hip_empty_host_obj == "" } {
	verbose "compiling empty host object"
	set empty_src [standard_temp_file empty-host.c]
	set gdb_saved_hip_empty_host_obj ${objdir}/empty-host.o
	set f [open $empty_src "w"]
	close $f
	set res [gdb_compile $empty_src $gdb_saved_hip_empty_host_obj object hip]
	if {$res != ""} {
	    return $res
	}
    }

    # Bundle device and host objects.
    set res [remote_exec host \
		 "${rocm_path}/llvm/bin/clang-offload-bundler\
				-type=o\
				-targets=hip-amdgcn-amd-amdhsa-unknown-${gpu_target},host-x86_64-unknown-linux-gnu\
				-outputs=$dest\
				-inputs=$tmp_o,$gdb_saved_hip_empty_host_obj"]
    # We're done.
    return [lindex $res 1]
}

# The lock file used to ensure that only one GDB has access to the GPU
# at a time.
set gpu_lock_filename gpu-parallel.lock

# Run body under the GPU lock.  Also calls gdb_exit before releasing
# the GPU lock.

proc with_rocm_gpu_lock { body } {
    with_lock $::gpu_lock_filename {uplevel 1 $body}

    # In case BODY returned early due to some testcase failing, and
    # left GDB running, debugging the GPU.
    gdb_exit
}

# Build an OpenCL kernel library from SOURCES.
# Ignore target boards multilib_flags.

proc gdb_compile_ocl_kernel {sources dest options} {
    set outdir [file dirname $dest]
    set objects ""
    foreach source $sources {
	if {[file extension $source] == ".o"} {
	    # Already a .o file.
	    lappend objects $source
	    continue
	}

	set sourcebase [file tail $source]
	set object ${outdir}/${sourcebase}.o

	if {[gdb_compile_ocl $source $object object \
	     $options] != ""} {
	    return -1
	}

	lappend objects $object
    }

    if {[gdb_compile_ocl "${objects}" "${dest}" executable $options] != ""} {
	return -1
    }

    return ""
}

# Compile OpenCL kernel source files specified by SOURCE into a binary
# of type TYPE at path DEST.  gdb_compile is implemented using
# DejaGnu's target_compile, so the type parameter and most options are
# passed directly to it.
#
# The type can be one of the following:
#
#   - object: Compile into an object file.
#   - executable: Compile and link into an executable.
#   - preprocess: Preprocess the source files.
#   - assembly: Generate assembly listing.
#
# And here are some of the not too obscure options understood by DejaGnu that
# influence the compilation:
#
#   - additional_flags=flag: Add FLAG to the compiler flags.
#   - libs=library: Add LIBRARY to the libraries passed to the linker.  The
#     argument can be a file, in which case it's added to the sources, or a
#     linker flag.
#   - ldflags=flag: Add FLAG to the linker flags.
#   - incdir=path: Add PATH to the searched include directories.
#   - libdir=path: Add PATH to the linker searched directories.
#   - debug: Build with debug information.
#   - optimize: Build with optimization.

proc gdb_compile_ocl {source dest type options} {
    global rocm_path
    global CC_FOR_TARGET
    global CXX_FOR_TARGET
    global board

    set outdir [file dirname $dest]

    verbose "options are $options"
    verbose "source is $source $dest $type $options"

    # Override the host compiler with a rocm one.
    save_vars {CC_FOR_TARGET CXX_FOR_TARGET} {
	set CC_FOR_TARGET ${rocm_path}/llvm/bin/clang
	set CXX_FOR_TARGET ${rocm_path}/llvm/bin/clang

	# target_compile always adds -lm which is not supported for
	# kernel compilation.
	set board [target_info name]
	if [board_info $board exists mathlib] {
	    set mathlib [board_info $board mathlib]
	    set_board_info mathlib ""
	    set result [target_compile $source $dest $type $options]
	    set_board_info mathlib $mathlib
	} else {
	    set_board_info mathlib ""
	    set result [target_compile $source $dest $type $options]
	    unset_board_info mathlib
	}
    }

    # Prune uninteresting compiler (and linker) output.
    regsub "Creating library file: \[^\r\n\]*\[\r\n\]+" $result "" result
    regsub "\[\r\n\]*$" "$result" "" result
    regsub "^\[\r\n\]*" "$result" "" result

    return $result
}

# Run "info threads INF_NUM", return the number of "AMDGPU Wave" threads found.

proc info_threads_get_wave_count { inf_num } {
    set wave_count 0
    gdb_test_multiple "info threads ${inf_num}.*" "" {
	-re "AMDGPU Wave\[^\r\n\]+\r\n" {
	    incr wave_count
	    exp_continue
	}

	-re "$::gdb_prompt " {
	    pass $gdb_test_name
	}
    }

    return $wave_count
}

# Return a list of valid "AMDGPU Wave" thread IDs.

proc info_thread_get_wave_list { } {
    global gdb_prompt
    global expect_out

    set thr_list ""

    gdb_test_multiple "info threads" "get AMDGPU waves list" -lbl {
	-re "($::decimal) *AMDGPU Wave\[^\r\n\]+" {
	    lappend thr_list $expect_out(1,string)
	    exp_continue
	}
	-re -wrap "" {
	    if { [llength $thr_list] != 0 } {
		pass $gdb_test_name
	    } else {
		fail "$gdb_test_name (no waves)"
	    }
	}
    }

  return $thr_list
}

# Get the GPU architecture for the current thread.

proc get_current_gpu_arch {} {
    set arch ""
    gdb_test_multiple "info agents" "" -lbl {
	-re "\r\n\\*\[^\r\n\]*gfx(\[a-f0-9\]+) \[^\r\n\]+" {
	    set arch $expect_out(1,string)
	    exp_continue
	}
	-re -wrap "" {
	    gdb_assert {"$arch" != ""} $gdb_test_name
	}
    }
    return $arch
}

# Return true if all the devices support debugging multiple processes
# using the GPU.

proc hip_devices_support_debug_multi_process {} {
    set unsupported_targets {
	gfx900 gfx906 gfx908
	gfx1010 gfx1011 gfx1012 gfx1030 gfx1031 gfx1032
    }

    set targets [find_amdgpu_devices]
    if { [llength $targets] == 0 } {
	return 0
    }

    foreach target $targets {
	if { [lsearch -exact $unsupported_targets $target] != -1 } {
	    return 0
	}
    }
    return 1
}

# Helpers below gate cooperative-group debugging tests, i.e. tests that
# debug kernels launched with hipLaunchCooperativeKernel and
# synchronized via cooperative_groups::this_grid ().sync ().
#
# This is a debugger-side gate, distinct from what the HIP runtime
# advertises via hipDeviceProp_t::cooperativeLaunch: the Global Wave
# Sync (GWS) hardware implementing the grid barrier exists on
# architectures where the kernel runs correctly outside the debugger
# but ROCgdb cannot yet step or breakpoint through the cooperative
# dispatch.

# Return true if TARGET (a gfx name like "gfx90a") is an architecture
# where ROCgdb supports debugging cooperative-group kernels.

proc target_supports_cooperative_groups { target } {
    set unsupported_targets {
	gfx1100 gfx1101 gfx1102 gfx1103
    }

    return [expr {[lsearch -exact $unsupported_targets $target] == -1}]
}

# Return true if every AMDGPU device on the system is an architecture
# where ROCgdb supports debugging cooperative-group kernels.

proc supports_cooperative_groups {} {
    set targets [find_amdgpu_devices]
    if { [llength $targets] == 0 } {
	return 0
    }

    foreach target $targets {
	if { ![target_supports_cooperative_groups $target] } {
	    return 0
	}
    }
    return 1
}

# Return true if the current device's version is less than VERSION.
#
# VERSION must be the "gfx" name of the device, such as gfx906 or gfx90a.

proc hip_device_is_less_than { version } {
  # Pick the first device as the current one.
  # The list can't be empty.  Else, allow_hip_tests would've caught it.
  set target [lindex [find_amdgpu_devices] 0]

  # Strip "gfx" prefix.
  regexp {gfx(.*)} $version unused version
  regexp {gfx(.*)} $target unused target

  # Pad with many zeroes to make sure we have strings of the same length.
  set version [format %08s $version]
  set target [format %08s $target]

  # Do a lexicographical comparison.
  set res [expr {[string compare $target $version] < 0}]
  verbose -log "$target is less than $version: $res"

  return $res
}

# Helper function for rocm_core_find.

proc rocm_core_find_1 {coredir binfile {arg ""} \
		       {use_pipe false}} {
    if { $use_pipe } {
	set coredump_pattern "|tee $coredir/$binfile"
    } else {
	set coredump_pattern "gpucore.%p"
    }
    # If we don't set the pattern here, on ROCm 7.3+ runtimes,
    # we will end up with "core.<pid>.gpu".  The "core_find {}"
    # procedure in "lib/gdb.exp" does not like that.  It expects
    # only one hit for the glob pattern "core.*".  Without this
    # pattern, there will be 2 hits: core.<pid> and core.<pid>.gpu
    save_vars { ::env(HSA_COREDUMP_PATTERN) } {
	set ::env(HSA_COREDUMP_PATTERN) $coredump_pattern
	set destcore [core_find_1 $coredir $binfile $arg]
    }
    set gpucore "$binfile.gpucore"

    # Search for a GPU core dump, if any.
    set gpucore_list [glob -nocomplain -directory $coredir gpucore.*]
    if {[llength $gpucore_list] == 1} {
	remote_exec build "mv [lindex $gpucore_list 0] $gpucore"
    } else {
	return ""
    }

    # If we have both host and GPU cores, they need to be merged together.
    if {[remote_file build exists $destcore]
	    && [remote_file build exists $gpucore]} {
	set coremerge [gdb_find_coremerge]
	remote_exec build "mv $destcore $binfile.hostcore"
	remote_exec build "$coremerge $destcore $binfile.hostcore $gpucore"

	if {![remote_file build exists $destcore]} {
	    warning "Could not join host and AMDGPU cores.  Check COREMERGE."
	}
    }

    if {![remote_file build exists $destcore]} {
	return ""
    }
    return $destcore
}

# Variant of the core_find proc for rocm.
#
# When using ROCm, if a fault is detected on the GPU, the runtime generates a
# core dump containing all GPU related data, then aborts and let the kernel
# generate a "regular" host-side core dump.  This proc looks for the GPU core
# dump and merges it with the CPU core dump found by core_find.  If either
# of the GPU and host core dump is missing, return an empty string.

proc rocm_core_find {binfile {deletefiles {}} {arg ""} \
			      {use_pipe false}} {
    return [with_tmpdir coredir $deletefiles rocm_core_find_1 $binfile $arg \
	    $use_pipe]
}

# Helper function calling "generate-core-file COREFILE_PATH".
#
# If an AMDGPU core dump is successfully generated, issue a PASS and return 1.
# If a configuration limitation is detected preventing the creation of an
# AMDGPU core dump, issue an UNSUPPORTED, and return 0.  If any other error is
# detected, issue a FAIL and return 0.

proc rocm_generate_core_file { corefile_path } {
    # On some configurations, creating the core dump can take a significant
    # amount of time.  Make sure to use an appropriate timeout value.
    with_timeout_factor 5 {
	gdb_test_multiple "generate-core-file $corefile_path" "generate core" {
	    -re -wrap "Cannot create an AMDGPU core dump.*" {
		unsupported $gdb_test_name
	     }
	    -re -wrap "Saved corefile .*" {
		pass $gdb_test_name
		return 1
	    }
	}
    }
    return 0
}

# Look for the FIELD in the definition (ptype) of register REG.
# Return the starting bit offset of that FIELD.

proc find_bit_offset_in_reg {reg field} {
    set bit_offset ""
    gdb_test_multiple "ptype \$$reg" "" -lbl {
	-re " *bool \[^\r\n \]*[string_to_regexp $field] @(\[0-9\]+);" {
	    set bit_offset $expect_out(1,string)
	    exp_continue
	}
	-re -wrap "" {
	    gdb_assert {"$bit_offset" != ""} $gdb_test_name
	}
    }
    return $bit_offset
}

# Enable ALU exception EXCP_NAME for the currently selected wave.
# This is architecture dependent:
#
#   gfx <  0x1200  -- the "mode" register must be modified.
#                     the DX10_CLAMP bit must cleared.
#
#   gfx >= 0x1200  -- the "trap_ctrl" register must be modified.

proc enable_alu_exception {excp_name} {
    set arch 0x[get_current_gpu_arch]
    if {$arch < 0x1200} {
	# For generations prior to gfx12, ALU exceptions are not reported when
	# the DX10_CLAMP bit is set.  Clear it.
	with_test_prefix "clear DX10_CLAMP" {
	    set clamp_bit_offset [find_bit_offset_in_reg "mode" "DX10_CLAMP"]
	    gdb_test \
		"p \$mode &= ~(1 << ${clamp_bit_offset})" \
		"(?!.*DX10_CLAMP).*" \
		"clear MODE.DX10_CLAMP"
	}
	set regname "mode"
    } else {
	set regname "trap_ctrl"
    }

    # The FLOAT_DIV0 flag is named EXCP_ENABLE.DIV0 (not to be confused with
    # EXCP_EN.INT_DIV0).
    set excp_name [string toupper $excp_name]
    if {$arch < 0x1200 && $excp_name == "FLOAT_DIV0"} {
	set excp_name "EXCP_EN.DIV0"
    }

    set bit_offset [find_bit_offset_in_reg $regname $excp_name]
    gdb_test \
	"p \$$regname |= (1 << $bit_offset)" \
	"= .*$excp_name.*"
}

# Try to find llvm-dwardump first in the PATH, then in
# (assumed) ROCM_PATH.  If not found, return empty string.

gdb_caching_proc find_dwarfdump {} {
    global rocm_path
    foreach ddump [list "llvm-dwarfdump" \
			"${rocm_path}/lib/llvm/bin/llvm-dwarfdump" ] {
	set res [catch {exec $ddump --version} output]
	if {$res == 0} {
	    return $ddump
	  }
    }
    return ""
}

# Read the DW_AT_language of the output binary and return:
#
#   "hip"       -- if DW_LANG_HIP (48, 0x30)
#   "cpp"       -- if DW_LANG_C_plus_plus_14 (33, 0x21)
#   "others"    -- if other languages
#   "unknown"   -- in case of failure

gdb_caching_proc compiler_dwarf_language {} {
    if {![gdb_simple_compile check_my_lang {
	    int foo (void) { return 42; }
	  } object {hip}]} {
	fail "language detection (compiling a sample program)"
	return "unknown"
    }

    set dwarfdump [find_dwarfdump]
    if {$dwarfdump == ""} {
	fail "language detection (dwarfdump not found)"
	return "unknown"
    }

    set cmd [list $dwarfdump $obj |& grep "DW_AT_language"]
    set res [catch {exec {*}$cmd} output]
    verbose -log "running: $cmd"
    verbose -log "result: $res"
    verbose -log "output: $output"
    if {$res != 0} {
	fail "language detection (dwarfdump execution)"
	return "unknown"
    }

    set matches [regexp -inline -all \
		   "DW_AT_language\[ \t\]*\\((DW_LANG_.*)\\)" \
		   $output]
    # There must be only one instance (1 line found + 1 match group -> 2)
    if {[llength $matches] != 2} {
	fail "language detection (extracting language)"
	return "unknown"
    }
    set lang [lindex $matches 1]
    verbose -log "language: $lang"

    if {$lang == "DW_LANG_HIP"} {
	return "hip"
    } elseif {$lang == "DW_LANG_C_plus_plus_14"} {
	return "cpp"
    } else {
	return "others"
    }
}

# OpenMP GPU offload support.
#
# The procs below extend the ROCm test framework to support running
# tests that use the OpenMP "target" construct to offload code to
# the GPU.

# Return 1 if the C/C++ OpenMP-offload toolchain and a usable AMD GPU
# are both available; otherwise return a {0 reason} pair suitable for
# 'require'.
#
# The actual OpenMP-offload compile is driven by gdb_compile's
# "omp-rocm" option, which selects the AMD compiler (amdclang /
# amdclang++ / amdflang) and adds the offload flags.

gdb_caching_proc allow_omp_offload_tests {} {
    # Reuse the shared ROCm gate (native target, amd-dbgapi support and
    # a usable AMD GPU device); the device check compiles a HIP program
    # with amdclang++, proving the AMD LLVM toolchain that ships
    # amdclang / amdclang++ is present.  OpenMP offload only adds a
    # Linux-only restriction on top.
    set base [allow_hip_tests]
    if {[lindex $base 0] == 0} {
	return $base
    }

    if {![istarget "*-linux*"]} {
	return {0 "OpenMP offload is only tested on Linux"}
    }

    return 1
}

# Same as above, but also requires amdflang for Fortran tests.

gdb_caching_proc allow_omp_offload_fortran_tests {} {
    set base [allow_omp_offload_tests]
    if {[lindex $base 0] == 0} {
	return $base
    }

    # Fortran offload needs amdflang specifically.  Resolve it through
    # the same discovery default_target_compile uses, and confirm it
    # actually runs.
    if {[catch {exec [gdb_find_amd_omp_compiler amdflang] --version}]} {
	return {0 "amdflang not available"}
    }
    return 1
}