+2021-02-25 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ 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 <andrew.burgess@embecosm.com>
* f-exp.y (f77_keywords): Add 'associated'.
/* 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. */
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)
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 *
+2021-02-25 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ 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 <andrew.burgess@embecosm.com>
* gdb.fortran/associated.exp: New file.
--- /dev/null
+! 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 <http://www.gnu.org/licenses/>.
+
+! 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
--- /dev/null
+! 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 <http://www.gnu.org/licenses/>.
+
+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
--- /dev/null
+# 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 <http://www.gnu.org/licenses/> .
+
+# 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 = <unknown return 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 = <unknown return 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"
+}
projects / thirdparty / binutils-gdb.git / commitdiff
