1 # Copyright
2019-2023 Free Software Foundation
, Inc.
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.
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.
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
/> .
16 # Further testing of placing breakpoints in nested subroutines.
18 require allow_fortran_tests
19 load_lib
"fortran.exp"
21 standard_testfile
".f90"
23 if {[build_executable $
{testfile
}.exp $
{testfile
} \
24 $
{srcfile
} {debug f90
}]} {
28 set int4
[fortran_int4
]
30 # When WITH_SRC_PREFIX_P is true
then some symbol references will be
31 # prefixed with the filename. When WITH_NEST_PREFIX_P is true
then
32 # nested subroutine symbols will be prefixed with their parent
34 proc do_bp_tests
{with_src_prefix_p with_nest_prefix_p
} {
35 global testfile srcfile
39 clean_restart $
{testfile
}
41 if { $with_src_prefix_p
} {
42 set src_prefix
"${srcfile}:"
47 if { $with_nest_prefix_p
} {
48 set nest_prefix
"contains_keyword::"
53 # Normally
, info symbol prints the symbol table
name for any fortran
54 # symbols
(since symbol lookup happens via the minimal symbol
55 # table
). This would correspond to the linkage
name in the full symbol
57 #
For gfortran
(and maybe others
) these names currently have the form
58 # XXXX.NUMBER where XXXX is the symbol
name and NUMBER a compiler generated
59 # appendix
for mangling. This mangled
name gets recognized by the Ada
60 # demangler
/decoder and decoded as Ada
(setting the symbol language to Ada
)
61 # to XXXX. This leads to the somewhat unexpected output of XXXX over
62 # XXXX.NUMBER
for info symbol.
63 #
For ifort and ifx the generated linkage names have the form
64 # SCOPEA_SCOPEB_XXXX_ which is not recognized by the Ada demangler and thus
66 # Note that there is no Fortran mangling standard. We keep the
67 # gfortran behavior as is and extend the test to reflect ifx and ifort
69 proc get_linkage_name_pattern
{symbol_name
} {
71 if { [test_compiler_info
{ifort
-*} f90
]
72 ||
[test_compiler_info
{ifx
-*} f90
] } {
73 return "\(?:.*_\)?${symbol_name}_?"
79 # Test setting up breakpoints and otherwise examining nested
80 # functions before the
program starts.
81 with_test_prefix
"before start" {
84 [list
"increment" "${int4} \\\(${int4}\\\)"] \
85 [list
"increment_program_global" "${int4} \\\(void\\\)"] \
86 [list
"hidden_variable" "void \\\(void\\\)"]] {
87 set function
[lindex $entry
0]
88 set type
[lindex $entry
1]
90 # Currently referencing symbols using
'info',
91 #
'whatis' and
'ptype' before the
program is
92 # started doesn
't work. This is the same
93 # behaviour we see in C++ so I don't think this
94 # is a failure
, just a limitation in current GDB.
95 if { $
{with_nest_prefix_p
} } {
96 gdb_test
"info symbol ${nest_prefix}${function}" \
97 "[get_linkage_name_pattern ${function}] in section .*"
98 gdb_test
"whatis ${nest_prefix}${function}" \
100 gdb_test
"ptype ${nest_prefix}${function}" \
102 gdb_test
"print ${nest_prefix}${function}" \
103 "{${type}} $hex <contains_keyword::${function}>"
106 gdb_breakpoint
"${src_prefix}${nest_prefix}${function}"
110 #
Break on a contained function and run to it.
111 if {![runto $
{src_prefix
}[gdb_get_line_number
"pre_init"]]} {
115 #
Call a contained function.
116 if { $
{with_nest_prefix_p
} } {
117 gdb_test_stdio
"call ${nest_prefix}subroutine_to_call()" " called" ""
120 #
Break on another contained function and run to it.
121 gdb_breakpoint
"${src_prefix}${nest_prefix}increment"
122 gdb_continue_to_breakpoint
"increment" ".*increment = i \\\+ 1"
123 gdb_breakpoint $
{src_prefix
}[gdb_get_line_number
"post_increment"]
124 gdb_continue_to_breakpoint
"post_increment"
126 # Check arguments and locals
report the correct
values.
12 is
127 # passed in and
13 is the result after adding
1.
128 gdb_test
"info args" "i = 12"
129 gdb_test
"info locals" " = 13"
131 # Check we can see variables from an outer
program scope.
132 gdb_breakpoint $
{src_prefix
}[gdb_get_line_number
"post_increment_global"]
133 gdb_continue_to_breakpoint
"post_increment_global" \
134 ".*print \\\*, program_i ! post_increment_global"
135 gdb_test
"info args" "No arguments." \
136 "no argument subroutine has no arguments"
137 gdb_test
"p program_i" " = 7" "printing outer scoped variable"
139 # Stepping into a contained subroutine.
140 gdb_breakpoint $
{src_prefix
}[gdb_get_line_number
"pre_step"]
141 gdb_continue_to_breakpoint
"pre_step" ".*call step\\\(\\\) ! pre_step"
143 ".*print '\\\(A\\\)', \\\"step\\\" ! post_step" \
144 "step into the correct place"
146 # Local hides
program global.
147 gdb_breakpoint $
{src_prefix
}[gdb_get_line_number
"post_hidden"]
148 gdb_continue_to_breakpoint
"post_hidden" \
149 ".*print \\\*, program_i ! post_hidden"
150 gdb_test
"p program_i" " = 30" "printing hidden global"
152 # Check
info symbol
, whatis and ptype can find information
on
153 # these nested functions.
156 [list
"increment" "${int4} \\\(${int4}\\\)"] \
157 [list
"increment_program_global" "${int4} \\\(void\\\)"]] {
158 set function
[lindex $entry
0]
159 set type
[lindex $entry
1]
160 with_test_prefix $function
{
161 gdb_test
"info symbol ${nest_prefix}$function" \
162 "[get_linkage_name_pattern $function] in section .*"
163 gdb_test
"whatis ${nest_prefix}$function" \
165 gdb_test
"ptype ${nest_prefix}$function" \
171 foreach_with_prefix src_prefix
{ 0 1 } {
172 foreach_with_prefix nest_prefix
{ 0 1 } {
173 do_bp_tests $
{src_prefix
} $
{nest_prefix
}