binutils-gdb/gdb/testsuite/gdb.dwarf2/fortran-var-string.exp

# Copyright 2022 Free Software Foundation, Inc.

# 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/>.
load_lib dwarf.exp

# This test can only be run on targets which support DWARF-2 and use gas.
if {![dwarf2_support]} {
    return 0
}

standard_testfile .c -dw.S

# We need to know the size of integer and address types in order
# to write some of the debugging info we'd like to generate.
#
# For that, we ask GDB by debugging our dynarr-ptr.c program.
# Any program would do, but since we already have dynarr-ptr.c
# specifically for this testcase, might as well use that.

if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } {
    return -1
}

# Make some DWARF for the test.
set asm_file [standard_output_file $srcfile2]
Dwarf::assemble $asm_file {
    set int_size [get_sizeof "int" 4]

    get_func_info main
    get_func_info main_helper

    cu {} {
	DW_TAG_compile_unit {
                {DW_AT_language @DW_LANG_Fortran90}
                {DW_AT_name     fortran-var-string.f90}
                {DW_AT_comp_dir /tmp}
        } {
	    declare_labels integer_label string_label array_lb_label \
		array_ub_label

	    DW_TAG_subprogram {
		{name main}
		{low_pc $main_helper_start addr}
		{high_pc $main_helper_len data8}
		{DW_AT_type :$integer_label}
		{DW_AT_decl_file 1 data1}
		{DW_AT_decl_line 1 data1}
	    }

	    DW_TAG_subprogram {
		{name test_1_func}
		{low_pc $main_start addr}
		{high_pc $main_len data8}
		{DW_AT_type :$integer_label}
		{DW_AT_decl_file 1 data1}
		{DW_AT_decl_line 2 data1}
	    } {
		formal_parameter {
		    {name arg1}
		    {type :$string_label}
		}
	    }

	    DW_TAG_subprogram {
		{name test_2_func}
		{low_pc $main_start addr}
		{high_pc $main_len data8}
		{DW_AT_type :$integer_label}
		{DW_AT_decl_file 1 data1}
		{DW_AT_decl_line 3 data1}
	    } {
		formal_parameter {
		    {name arg1}
		    {type :$array_ub_label}
		}
	    }

	    DW_TAG_subprogram {
		{name test_3_func}
		{low_pc $main_start addr}
		{high_pc $main_len data8}
		{DW_AT_type :$integer_label}
		{DW_AT_decl_file 1 data1}
		{DW_AT_decl_line 4 data1}
	    } {
		formal_parameter {
		    {name arg1}
		    {type :$array_lb_label}
		}
	    }

	    integer_label: DW_TAG_base_type {
		{DW_AT_byte_size $int_size DW_FORM_sdata}
		{DW_AT_encoding  @DW_ATE_signed}
		{DW_AT_name      integer}
	    }

	    string_label: DW_TAG_string_type {
		{DW_AT_byte_size $int_size DW_FORM_sdata}
		{DW_AT_name      .str.arg}
		{DW_AT_string_length {} DW_FORM_block1}
	    }

	    array_lb_label: DW_TAG_array_type {
		{DW_AT_ordering 1 data1}
		{DW_AT_type :$integer_label}
	    } {
		DW_TAG_subrange_type {
		    {DW_AT_lower_bound {} DW_FORM_block1}
		    {DW_AT_upper_bound 10 DW_FORM_data1}
		}
	    }

	    array_ub_label: DW_TAG_array_type {
		{DW_AT_ordering 1 data1}
		{DW_AT_type :$integer_label}
	    } {
		DW_TAG_subrange_type {
		    {DW_AT_upper_bound {} DW_FORM_block1}
		}
	    }
	}
    }
}

# Now that we've generated the DWARF debugging info, rebuild our
# program using our debug info instead of the info generated by
# the compiler.

if { [prepare_for_testing "failed to prepare" ${testfile} \
	  [list $srcfile $asm_file] {nodebug}] } {
    return -1
}

if ![runto_main] {
    return -1
}

gdb_test_no_output "set language fortran"

gdb_test "info functions test_1_func" \
    "2:\\s+integer test_1_func\\(character\\*\\(\\*\\)\\);"

# We print `1` here as the bound because GDB treats this as an assumed
# size array, and just reports the lower bound value for the upper
# bound.
#
# We might, in the future, decide that there's a better way we could
# tell the user about the type of this array argument, when that
# happens it's OK to change the expected results here.
gdb_test "info functions test_2_func" \
    "3:\\s+integer test_2_func\\(integer \\(1\\)\\);"

# It's not completely clear that this error is correct here.  Why
# can't the lower bound be a dynamic expression?
#
# This test was initially added to guard against the case where GDB
# was crashing if/when it saw this situation.
#
# If later on, GDB's handling of array types with a dynamic loewr
# bound changes, then it is possible that the expected result here
# should change.
gdb_test "info functions test_3_func" \
    "4:\\s+Lower bound may not be '\\*' in F77"