diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 77814795d1d..a6a842f40eb 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,11 @@ +2021-02-25 Andrew Burgess + + PR fortran/26155 + * f-lang.c (fortran_argument_convert): Delete declaration. + (fortran_prepare_argument): New function. + (evaluate_subexp_f): Move logic to new function + fortran_prepare_argument. + 2021-02-25 Andrew Burgess * f-exp.y (f77_keywords): Add 'associated'. diff --git a/gdb/f-lang.c b/gdb/f-lang.c index 31fff34ae76..01de51837f6 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -68,8 +68,10 @@ show_fortran_array_slicing_debug (struct ui_file *file, int from_tty, /* Local functions */ -static struct value *fortran_argument_convert (struct value *value, - bool is_artificial); +static value *fortran_prepare_argument (struct expression *exp, int *pos, + int arg_num, bool is_internal_call_p, + struct type *func_type, + enum noside noside); /* Return the encoding that should be used for the character type TYPE. */ @@ -1278,22 +1280,11 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp, int tem = 1; for (; tem <= nargs; tem++) { - argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside); - /* Arguments in Fortran are passed by address. Coerce the - arguments here rather than in value_arg_coerce as - otherwise the call to malloc to place the non-lvalue - parameters in target memory is hit by this Fortran - specific logic. This results in malloc being called - with a pointer to an integer followed by an attempt to - malloc the arguments to malloc in target memory. - Infinite recursion ensues. */ - if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC) - { - bool is_artificial - = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1); - argvec[tem] = fortran_argument_convert (argvec[tem], - is_artificial); - } + bool is_internal_func = (code == TYPE_CODE_INTERNAL_FUNCTION); + argvec[tem] + = fortran_prepare_argument (exp, pos, (tem - 1), + is_internal_func, + value_type (arg1), noside); } argvec[tem] = 0; /* signal end of arglist */ if (noside == EVAL_SKIP) @@ -1780,6 +1771,59 @@ fortran_argument_convert (struct value *value, bool is_artificial) return value; } +/* Prepare (and return) an argument value ready for an inferior function + call to a Fortran function. EXP and POS are the expressions describing + the argument to prepare. ARG_NUM is the argument number being + prepared, with 0 being the first argument and so on. FUNC_TYPE is the + type of the function being called. + + IS_INTERNAL_CALL_P is true if this is a call to a function of type + TYPE_CODE_INTERNAL_FUNCTION, otherwise this parameter is false. + + NOSIDE has its usual meaning for expression parsing (see eval.c). + + Arguments in Fortran are normally passed by address, we coerce the + arguments here rather than in value_arg_coerce as otherwise the call to + malloc (to place the non-lvalue parameters in target memory) is hit by + this Fortran specific logic. This results in malloc being called with a + pointer to an integer followed by an attempt to malloc the arguments to + malloc in target memory. Infinite recursion ensues. */ + +static value * +fortran_prepare_argument (struct expression *exp, int *pos, + int arg_num, bool is_internal_call_p, + struct type *func_type, enum noside noside) +{ + if (is_internal_call_p) + return evaluate_subexp_with_coercion (exp, pos, noside); + + bool is_artificial = ((arg_num >= func_type->num_fields ()) + ? true + : TYPE_FIELD_ARTIFICIAL (func_type, arg_num)); + + /* If this is an artificial argument, then either, this is an argument + beyond the end of the known arguments, or possibly, there are no known + arguments (maybe missing debug info). + + For these artificial arguments, if the user has prefixed it with '&' + (for address-of), then lets always allow this to succeed, even if the + argument is not actually in inferior memory. This will allow the user + to pass arguments to a Fortran function even when there's no debug + information. + + As we already pass the address of non-artificial arguments, all we + need to do if skip the UNOP_ADDR operator in the expression and mark + the argument as non-artificial. */ + if (is_artificial && exp->elts[*pos].opcode == UNOP_ADDR) + { + (*pos)++; + is_artificial = false; + } + + struct value *arg_val = evaluate_subexp_with_coercion (exp, pos, noside); + return fortran_argument_convert (arg_val, is_artificial); +} + /* See f-lang.h. */ struct type * diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 21c98fa941a..bbe4e5cbfeb 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2021-02-25 Andrew Burgess + + PR fortran/26155 + * gdb.fortran/call-no-debug-func.f90: New file. + * gdb.fortran/call-no-debug-prog.f90: New file. + * gdb.fortran/call-no-debug.exp: New file. + 2021-02-25 Andrew Burgess * gdb.fortran/associated.exp: New file. diff --git a/gdb/testsuite/gdb.fortran/call-no-debug-func.f90 b/gdb/testsuite/gdb.fortran/call-no-debug-func.f90 new file mode 100644 index 00000000000..0075c0797c5 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/call-no-debug-func.f90 @@ -0,0 +1,29 @@ +! Copyright 2020-2021 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 . + +! Return ARG plus 1. +integer function some_func (arg) + integer :: arg + + some_func = (arg + 1) +end function some_func + +! Print STR. +integer function string_func (str) + character(len=*) :: str + + print *, str + string_func = 0 +end function string_func diff --git a/gdb/testsuite/gdb.fortran/call-no-debug-prog.f90 b/gdb/testsuite/gdb.fortran/call-no-debug-prog.f90 new file mode 100644 index 00000000000..514c9c8d564 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/call-no-debug-prog.f90 @@ -0,0 +1,35 @@ +! Copyright 2020-2021 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 . + +program main + implicit none + + interface + integer function some_func (arg) + integer :: arg + end function some_func + + integer function string_func (str) + character(len=*) :: str + end function string_func + end interface + + integer :: val + + val = some_func (1) + print *, val + val = string_func ('hello') + print *, val +end program main diff --git a/gdb/testsuite/gdb.fortran/call-no-debug.exp b/gdb/testsuite/gdb.fortran/call-no-debug.exp new file mode 100644 index 00000000000..82bf32c82c7 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/call-no-debug.exp @@ -0,0 +1,102 @@ +# Copyright 2020-2021 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 . + +# Test calling Fortran functions that are compiled without debug +# information. + +if {[skip_fortran_tests]} { return -1 } + +standard_testfile call-no-debug-prog.f90 call-no-debug-func.f90 +load_lib fortran.exp + +if {[prepare_for_testing_full "failed to prepare" \ + [list ${binfile} [list debug f90] \ + $srcfile [list debug f90] \ + $srcfile2 [list nodebug f90]]]} { + return -1 +} + +if ![fortran_runto_main] { + untested "could not run to main" + return -1 +} + +# Find a possibly mangled version of NAME, a function we want to call +# that has no debug information available. We hope that the mangled +# version of NAME contains the pattern NAME, and so we use 'info +# functions' to find a possible suitable symbol. +# +# If no suitable function is found then return the empty string. +proc find_mangled_name { name } { + global hex gdb_prompt + + set into_non_debug_symbols false + set symbol_name "*unknown*" + gdb_test_multiple "info function $name" "" { + -re ".*Non-debugging symbols:\r\n" { + set into_non_debug_symbols true + exp_continue + } + -re "$hex.*\[ \t\]+(\[^\r\n\]+)\r\n" { + set symbol_name $expect_out(1,string) + exp_continue + } + -re "^$gdb_prompt $" { + # Done. + } + } + + # If we couldn't find a suitable symbol name return the empty + # string. + if { $symbol_name == "*unknown*" } { + return "" + } + + return $symbol_name +} + +# Call the function SOME_FUNC, that takes a single integer and returns +# an integer. As the function has no debug information then we have +# to pass the integer argument as '&1' so that GDB will send the +# address of an integer '1' (as Fortran arguments are pass by +# reference). +set symbol_name [find_mangled_name "some_func"] +if { $symbol_name == "" } { + untested "couldn't find suitable name for 'some_func'" +} else { + gdb_test "ptype ${symbol_name}" "type = \\(\\)" + gdb_test "print ${symbol_name} (&1)" \ + "'${symbol_name}' has unknown return type; cast the call to its declared return type" + gdb_test "print (integer) ${symbol_name} (&1)" " = 2" +} + +# Call the function STRING_FUNC which takes an assumed shape character +# array (i.e. a string), and returns an integer. +# +# At least for gfortran, passing the string will pass both the data +# pointer and an artificial argument, the length of the string. +# +# The compiled program is expecting the address of the string, so we +# prefix that argument with '&', but the artificial length parameter +# is pass by value, so there's no need for '&' in that case. +set symbol_name [find_mangled_name "string_func"] +if { $symbol_name == "" } { + untested "couldn't find suitable name for 'string_func'" +} else { + gdb_test "ptype ${symbol_name}" "type = \\(\\)" + gdb_test "print ${symbol_name} (&'abcdefg', 3)" \ + "'${symbol_name}' has unknown return type; cast the call to its declared return type" + gdb_test "call (integer) ${symbol_name} (&'abcdefg', 3)" " abc\r\n\\\$\\d+ = 0" +}