From 4c937052c13b13053559a5aa2b1345545a185ca5 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Thu, 24 Feb 2022 09:01:42 -0700 Subject: Fix crash in Fortran code PR fortran/28801 points out a gdb crash that can be provoked by certain Fortran code. The bug is that f77_get_upperbound assumes the property is either a constant or undefined, but in this case it is PROP_LOCEXPR. This patch fixes the crash by making this function (and the lower-bound one as well) do the correct check before calling 'const_val'. Thanks to Andrew for writing the test case. Co-authored-by: Andrew Burgess Bug: https://sourceware.org/bugzilla/show_bug.cgi?id=28801 --- gdb/f-valprint.c | 4 +- gdb/testsuite/gdb.dwarf2/fortran-var-string.c | 31 +++++ gdb/testsuite/gdb.dwarf2/fortran-var-string.exp | 175 ++++++++++++++++++++++++ 3 files changed, 208 insertions(+), 2 deletions(-) create mode 100644 gdb/testsuite/gdb.dwarf2/fortran-var-string.c create mode 100644 gdb/testsuite/gdb.dwarf2/fortran-var-string.exp (limited to 'gdb') diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c index 6a199f1..b64750b 100644 --- a/gdb/f-valprint.c +++ b/gdb/f-valprint.c @@ -43,7 +43,7 @@ static void f77_get_dynamic_length_of_aggregate (struct type *); LONGEST f77_get_lowerbound (struct type *type) { - if (type->bounds ()->low.kind () == PROP_UNDEFINED) + if (type->bounds ()->low.kind () != PROP_CONST) error (_("Lower bound may not be '*' in F77")); return type->bounds ()->low.const_val (); @@ -52,7 +52,7 @@ f77_get_lowerbound (struct type *type) LONGEST f77_get_upperbound (struct type *type) { - if (type->bounds ()->high.kind () == PROP_UNDEFINED) + if (type->bounds ()->high.kind () != PROP_CONST) { /* We have an assumed size array on our hands. Assume that upper_bound == lower_bound so that we show at least 1 element. diff --git a/gdb/testsuite/gdb.dwarf2/fortran-var-string.c b/gdb/testsuite/gdb.dwarf2/fortran-var-string.c new file mode 100644 index 0000000..a677b7e --- /dev/null +++ b/gdb/testsuite/gdb.dwarf2/fortran-var-string.c @@ -0,0 +1,31 @@ +/* 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 . */ + +/* In the generated DWARF, we'll pretend that ARG is a string with dynamic + length. */ +int +main_helper (void *arg) +{ + asm ("main_helper_label: .globl main_helper_label"); + return 0; +} + +int +main (void) +{ + asm ("main_label: .globl main_label"); + main_helper (0); + return 0; +} diff --git a/gdb/testsuite/gdb.dwarf2/fortran-var-string.exp b/gdb/testsuite/gdb.dwarf2/fortran-var-string.exp new file mode 100644 index 0000000..793c441 --- /dev/null +++ b/gdb/testsuite/gdb.dwarf2/fortran-var-string.exp @@ -0,0 +1,175 @@ +# 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 . +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" -- cgit v1.1