1# Copyright 2022-2023 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/>.
15load_lib dwarf.exp
16
17# This test can only be run on targets which support DWARF-2 and use gas.
18if {![dwarf2_support]} {
19    return 0
20}
21
22standard_testfile .c -dw.S
23
24# We need to know the size of integer and address types in order
25# to write some of the debugging info we'd like to generate.
26#
27# For that, we ask GDB by debugging our dynarr-ptr.c program.
28# Any program would do, but since we already have dynarr-ptr.c
29# specifically for this testcase, might as well use that.
30
31if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } {
32    return -1
33}
34
35# Make some DWARF for the test.
36set asm_file [standard_output_file $srcfile2]
37Dwarf::assemble $asm_file {
38    set int_size [get_sizeof "int" 4]
39
40    get_func_info main
41    get_func_info main_helper
42
43    cu {} {
44	DW_TAG_compile_unit {
45                {DW_AT_language @DW_LANG_Fortran90}
46                {DW_AT_name     fortran-var-string.f90}
47                {DW_AT_comp_dir /tmp}
48        } {
49	    declare_labels integer_label string_label array_lb_label \
50		array_ub_label
51
52	    DW_TAG_subprogram {
53		{name main}
54		{low_pc $main_helper_start addr}
55		{high_pc $main_helper_len data8}
56		{DW_AT_type :$integer_label}
57		{DW_AT_decl_file 1 data1}
58		{DW_AT_decl_line 1 data1}
59	    }
60
61	    DW_TAG_subprogram {
62		{name test_1_func}
63		{low_pc $main_start addr}
64		{high_pc $main_len data8}
65		{DW_AT_type :$integer_label}
66		{DW_AT_decl_file 1 data1}
67		{DW_AT_decl_line 2 data1}
68	    } {
69		formal_parameter {
70		    {name arg1}
71		    {type :$string_label}
72		}
73	    }
74
75	    DW_TAG_subprogram {
76		{name test_2_func}
77		{low_pc $main_start addr}
78		{high_pc $main_len data8}
79		{DW_AT_type :$integer_label}
80		{DW_AT_decl_file 1 data1}
81		{DW_AT_decl_line 3 data1}
82	    } {
83		formal_parameter {
84		    {name arg1}
85		    {type :$array_ub_label}
86		}
87	    }
88
89	    DW_TAG_subprogram {
90		{name test_3_func}
91		{low_pc $main_start addr}
92		{high_pc $main_len data8}
93		{DW_AT_type :$integer_label}
94		{DW_AT_decl_file 1 data1}
95		{DW_AT_decl_line 4 data1}
96	    } {
97		formal_parameter {
98		    {name arg1}
99		    {type :$array_lb_label}
100		}
101	    }
102
103	    integer_label: DW_TAG_base_type {
104		{DW_AT_byte_size $int_size DW_FORM_sdata}
105		{DW_AT_encoding  @DW_ATE_signed}
106		{DW_AT_name      integer}
107	    }
108
109	    string_label: DW_TAG_string_type {
110		{DW_AT_byte_size $int_size DW_FORM_sdata}
111		{DW_AT_name      .str.arg}
112		{DW_AT_string_length {} DW_FORM_block1}
113	    }
114
115	    array_lb_label: DW_TAG_array_type {
116		{DW_AT_ordering 1 data1}
117		{DW_AT_type :$integer_label}
118	    } {
119		DW_TAG_subrange_type {
120		    {DW_AT_lower_bound {} DW_FORM_block1}
121		    {DW_AT_upper_bound 10 DW_FORM_data1}
122		}
123	    }
124
125	    array_ub_label: DW_TAG_array_type {
126		{DW_AT_ordering 1 data1}
127		{DW_AT_type :$integer_label}
128	    } {
129		DW_TAG_subrange_type {
130		    {DW_AT_upper_bound {} DW_FORM_block1}
131		}
132	    }
133	}
134    }
135}
136
137# Now that we've generated the DWARF debugging info, rebuild our
138# program using our debug info instead of the info generated by
139# the compiler.
140
141if { [prepare_for_testing "failed to prepare" ${testfile} \
142	  [list $srcfile $asm_file] {nodebug}] } {
143    return -1
144}
145
146if ![runto_main] {
147    return -1
148}
149
150gdb_test_no_output "set language fortran"
151
152gdb_test "info functions test_1_func" \
153    "2:\\s+integer test_1_func\\(character\\*\\(\\*\\)\\);"
154
155# We print `1` here as the bound because GDB treats this as an assumed
156# size array, and just reports the lower bound value for the upper
157# bound.
158#
159# We might, in the future, decide that there's a better way we could
160# tell the user about the type of this array argument, when that
161# happens it's OK to change the expected results here.
162gdb_test "info functions test_2_func" \
163    "3:\\s+integer test_2_func\\(integer \\(1\\)\\);"
164
165# It's not completely clear that this error is correct here.  Why
166# can't the lower bound be a dynamic expression?
167#
168# This test was initially added to guard against the case where GDB
169# was crashing if/when it saw this situation.
170#
171# If later on, GDB's handling of array types with a dynamic loewr
172# bound changes, then it is possible that the expected result here
173# should change.
174gdb_test "info functions test_3_func" \
175    "4:\\s+Lower bound may not be '\\*' in F77"
176