[PATCH] Fortran function calls with arguments

classic Classic list List threaded Threaded
4 messages Options
Reply | Threaded
Open this post in threaded view
|

[PATCH] Fortran function calls with arguments

Richard Bunt
Prior to this patch, calling functions on the inferior with arguments and
then using these arguments within a function resulted in an invalid
memory access. This is because Fortran arguments are typically passed as
pointers to values.

It is possible to call Fortran functions, but memory must be allocated in
the inferior, so a pointer can be passed to the function, and the
language must be set to C to enable C-style casting. This is cumbersome
and not a pleasant debug experience.

This patch implements the GNU Fortran argument passing conventions with
caveats. Firstly, it does not handle the VALUE attribute as there is
insufficient DWARF information to determine when this is the case.
Secondly, functions with optional parameters can only be called with all
parameters present. Both these cases are marked as KFAILS in the test.

Since the GNU Fortran argument passing convention has been implemented,
there is no guarantee that this patch will work correctly, in all cases,
with other compilers.

Despite these limitations, this patch improves the ease with which
functions can be called in many cases, without taking away the existing
approach of calling with the language set to C.

It should be noted that bugs were found with printing complex numbers
while developing this patch. However, fixing this issue was considered
outside the scope of this patch. The test case for calling functions with
complex numbers should remain as a KFAIL.

Regression tested on x86_64, aarch64 and POWER9 with GCC 7.3.0.
Regression tested with Ada on x86_64.
Regression tested with native-extended-gdbserver target board.

gdb/ChangeLog:
2018-10-27  Richard Bunt  <[hidden email]>
        Dirk Schubert  <[hidden email]>
        Chris January  <[hidden email]>

        * gdb/eval.c (evaluate_subexp_standard): Call Fortran argument
        wrapping logic.
        * gdb/f-lang.c (struct value): A value which can be passed into a
        Fortran function call.
        (fortran_argument_convert): Wrap Fortran arguments in a pointer
        where appropriate.
        (struct type): Value ready for a Fortran function call.
        (fortran_preserve_arg_pointer): Undo check_typedef, the pointer
        is needed.
        * gdb/f-lang.h (fortran_argument_convert): Declaration.
        (fortran_preserve_arg_pointer): Declaration.
        * gdb/infcall.c (value_arg_coerce): Call Fortran argument
        logic.

gdb/testsuite/ChangeLog:
2018-10-27  Richard Bunt  <[hidden email]>

        * gdb/testsuite/gdb.fortran/function-calls.exp: New file.
        * gdb/testsuite/gdb.fortran/function-calls.f90: New test.
---
 gdb/eval.c                                   |  13 +-
 gdb/f-lang.c                                 |  48 ++++++
 gdb/f-lang.h                                 |   5 +-
 gdb/infcall.c                                |   5 +-
 gdb/testsuite/gdb.fortran/function-calls.exp | 104 ++++++++++++
 gdb/testsuite/gdb.fortran/function-calls.f90 | 242 +++++++++++++++++++++++++++
 6 files changed, 414 insertions(+), 3 deletions(-)
 create mode 100644 gdb/testsuite/gdb.fortran/function-calls.exp
 create mode 100644 gdb/testsuite/gdb.fortran/function-calls.f90

diff --git a/gdb/eval.c b/gdb/eval.c
index 47d08a656c0229ace5f2004f73eabb30c90a96a8..083e9531e103ba995910c26c12e4961024dab3b8 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -1987,7 +1987,18 @@ evaluate_subexp_standard (struct type *expect_type,
   argvec[0] = arg1;
   tem = 1;
   for (; tem <= nargs; tem++)
-    argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
+    {
+      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.  */
+      argvec[tem] = fortran_argument_convert (argvec[tem],
+ TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem-1));
+    }
   argvec[tem] = 0; /* signal end of arglist */
   if (noside == EVAL_SKIP)
     return eval_skip_value (exp);
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 4ff828ba75300ae5667313e74cfb9fcaffa9df2f..0c3118a511d55b20cb287a9e69fccb476579391c 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -27,6 +27,7 @@
 #include "parser-defs.h"
 #include "language.h"
 #include "varobj.h"
+#include "gdbcore.h"
 #include "f-lang.h"
 #include "valprint.h"
 #include "value.h"
@@ -371,3 +372,50 @@ _initialize_f_language (void)
 {
   f_type_data = gdbarch_data_register_post_init (build_fortran_types);
 }
+
+/* Ensures that function argument VALUE is in the appropriate form to
+   pass to a Fortran function.  Returns a possibly new value that should
+   be used instead of VALUE.
+
+   When IS_ARTIFICIAL is true this indicates an artificial argument,
+   e.g. hidden string lengths which the GNU Fortran argument passing
+   convention specifies as being passed by value.
+
+   When IS_ARTIFICIAL is false, the argument is passed by pointer.  If the
+   value is already in target memory then return a value that is a pointer
+   to VALUE.  If VALUE is not in memory (e.g. an integer literal), allocate
+   space in the target, copy VALUE in, and return a pointer to the in
+   memory copy.  */
+struct value *
+fortran_argument_convert (struct value *value, const bool is_artificial)
+{
+  if (!is_artificial)
+    {
+      if (VALUE_LVAL (value) == not_lval
+  || VALUE_LVAL (value) == lval_internalvar)
+ {
+  struct value *val = value_copy (value);
+  const int length = TYPE_LENGTH (value_type (val));
+  const CORE_ADDR addr
+    = value_as_long (value_allocate_space_in_inferior (length));
+  VALUE_LVAL (val) = lval_memory;
+  set_value_address (val, addr);
+  write_memory (addr, value_contents (val), length);
+  return value_addr (val);
+ }
+      else
+ return value_addr (value);
+    }
+    return value;
+}
+
+/* All arguments in Fortran are pointers.  If it is a pointer, preserve it so
+   that the address is passed rather than the value.  */
+struct type *
+fortran_preserve_arg_pointer (struct value *arg,
+      struct type *type)
+{
+  if (TYPE_CODE (value_type (arg)) == TYPE_CODE_PTR)
+    return value_type (arg);
+  return type;
+}
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index cab06f9806d4bed15f73b4c8da717d1ede2a7d5f..bccf082dae4c306c57b49f6a91306fc76ba3de54 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -78,4 +78,7 @@ struct builtin_f_type
 
 /* Return the Fortran type table for the specified architecture.  */
 extern const struct builtin_f_type *builtin_f_type (struct gdbarch *gdbarch);
-
+extern struct value *fortran_argument_convert (struct value *value,
+       const bool is_artificial);
+extern struct type *fortran_preserve_arg_pointer (struct value *arg,
+  struct type *type);
diff --git a/gdb/infcall.c b/gdb/infcall.c
index 14b0cbc716907ac790fd9c4fee89172fa2a33020..367048b7411900486855ddac5949aa655ea77853 100644
--- a/gdb/infcall.c
+++ b/gdb/infcall.c
@@ -33,6 +33,7 @@
 #include "command.h"
 #include "dummy-frame.h"
 #include "ada-lang.h"
+#include "f-lang.h"
 #include "gdbthread.h"
 #include "event-top.h"
 #include "observable.h"
@@ -129,7 +130,7 @@ show_unwind_on_terminating_exception_p (struct ui_file *file, int from_tty,
 }
 
 /* Perform the standard coercions that are specified
-   for arguments to be passed to C or Ada functions.
+   for arguments to be passed to C, Ada or Fortran functions.
 
    If PARAM_TYPE is non-NULL, it is the expected parameter type.
    IS_PROTOTYPED is non-zero if the function declaration is prototyped.
@@ -148,6 +149,8 @@ value_arg_coerce (struct gdbarch *gdbarch, struct value *arg,
   /* Perform any Ada-specific coercion first.  */
   if (current_language->la_language == language_ada)
     arg = ada_convert_actual (arg, type);
+  else if (current_language->la_language == language_fortran)
+    type = fortran_preserve_arg_pointer (arg, type);
 
   /* Force the value to the target if we will need its address.  At
      this point, we could allocate arguments on the stack instead of
diff --git a/gdb/testsuite/gdb.fortran/function-calls.exp b/gdb/testsuite/gdb.fortran/function-calls.exp
new file mode 100644
index 0000000000000000000000000000000000000000..e75336651b3947534e6a11766d4fdc5fa9b87d5d
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/function-calls.exp
@@ -0,0 +1,104 @@
+# Copyright 2019 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/> .
+
+# Exercise passing and returning arguments in Fortran. This test case
+# is based on the GNU Fortran Argument passing conventions.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} {debug f90}]} {
+    return -1
+}
+
+if {![runto [gdb_get_line_number "post_init"]]} then {
+    perror "couldn't run to breakpoint post_init"
+    continue
+}
+
+# Use inspired by gdb.base/callfuncs.exp.
+gdb_test_no_output "set unwindonsignal on"
+
+# Baseline: function and subroutine call with no arguments.
+gdb_test "p no_arg()" " = .TRUE."
+gdb_test_no_output "call no_arg_subroutine()"
+
+# Argument class: literal, inferior variable, convenience variable,
+# function call return value, function.
+# Paragraph 3: Variables are passed by reference.
+gdb_test "p one_arg(.TRUE.)" " = .TRUE."
+gdb_test "p one_arg(untrue)" " = .FALSE."
+gdb_test_no_output "set \$var = .FALSE."
+gdb_test "p one_arg(\$var)" " = .FALSE."
+gdb_test "p one_arg(one_arg(.TRUE.))" " = .TRUE."
+gdb_test "p one_arg(one_arg(.FALSE.))" " = .FALSE."
+gdb_test_no_output "call run(no_arg_subroutine)"
+
+# Return: constant.
+gdb_test "p return_constant()" " = 17"
+# Return derived type and call a function in a module.
+gdb_test "p derived_types_and_module_calls::build_cart(7,8)" \
+ " = \\\( x = 7, y = 8 \\\)"
+
+# Two hidden arguments. 1. returned string and 2. string length.
+# Paragraph 1.
+gdb_test "p return_string(returned_string_debugger, 40)" ""
+gdb_test "p returned_string_debugger" "'returned in hidden first argument       '"
+
+# Argument type: real(kind=4), complex, array, pointer, derived type,
+# derived type with allocatable, nested derived type.
+# Paragraph 4: pointer.
+gdb_test "p pointer_function(int_pointer)" " = 87"
+# Paragraph 4: array.
+gdb_test "call array_function(integer_array)" " = 17"
+gdb_test "p derived_types_and_module_calls::pass_cart(c)" \
+ " = \\\( x = 2, y = 4 \\\)"
+# Allocatable elements in a derived type. Technical report ISO/IEC 15581.
+gdb_test "p derived_types_and_module_calls::pass_cart_nd(c_nd)" " = 4"
+gdb_test "p derived_types_and_module_calls::pass_nested_cart(nested_c)" \
+  "= \\\( d = \\\( x = 1, y = 2 \\\), z = 3 \\\)"
+# Result within some tolerance.
+gdb_test "p real4_argument(real4)" " = 3.${decimal}"
+
+# Printing complex numbers through GDB doesn't work in general.
+# Paragraph 2.
+setup_kfail "gdb/NNNN" *-*-*
+gdb_test "p complex_argument(fft)" " = (2.${decimal},3.${decimal})"
+
+# Function with optional arguments.
+# Paragraph 10: Option reference arguments.
+gdb_test "p sum_some(1,2,3)" " = 6"
+# There is currently no mechanism to call a function without all
+# optional parameters present.
+setup_kfail "gdb/NNNN" *-*-*
+gdb_test "p sum_some(1,2)" " = 3"
+
+# Paragraph 10: optional value arguments. There is insufficient DWARF
+# information to reliably make this case work.
+setup_kfail "gdb/NNNN" *-*-*
+gdb_test "p one_arg_value(10)" " = 10"
+
+# DW_AT_artificial formal parameters must be passed manually. This
+# assert will fail if the length of the string is wrapped in a pointer.
+# Paragraph 7: Character type.
+gdb_test "p hidden_string_length('arbitrary string', 16)" " = 16"
+
+# Several arguments.
+gdb_test "p several_arguments(2, 3, 5)" " = 10"
+gdb_test "p mix_of_scalar_arguments(5, .TRUE., 3.5)" " = 9"
+
+# Calling other functions: Recursive call.
+gdb_test "p fibonacci(6)" " = 8"
diff --git a/gdb/testsuite/gdb.fortran/function-calls.f90 b/gdb/testsuite/gdb.fortran/function-calls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..19dbd65df61ec66db5108e3015b7b594acbe4cae
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/function-calls.f90
@@ -0,0 +1,242 @@
+! Copyright 2019 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/> .
+
+! Source code for function-calls.exp.
+
+subroutine no_arg_subroutine()
+end subroutine
+
+logical function no_arg()
+    no_arg = .TRUE.
+end function
+
+subroutine run(a)
+    external :: a
+    call a()
+end subroutine
+
+logical function one_arg(x)
+    logical, intent(in) :: x
+    one_arg = x
+end function
+
+integer(kind=4) function one_arg_value(x)
+    integer(kind=4), value :: x
+    one_arg_value = x
+end function
+
+integer(kind=4) function several_arguments(a, b, c)
+    integer(kind=4), intent(in) :: a
+    integer(kind=4), intent(in) :: b
+    integer(kind=4), intent(in) :: c
+    several_arguments = a + b + c
+end function
+
+integer(kind=4) function mix_of_scalar_arguments(a, b, c)
+    integer(kind=4), intent(in) :: a
+    logical(kind=4), intent(in) :: b
+    real(kind=8), intent(in) :: c
+    mix_of_scalar_arguments = a + floor(c)
+    if (b) then
+        mix_of_scalar_arguments=mix_of_scalar_arguments+1
+    end if
+end function
+
+real(kind=4) function real4_argument(a)
+    real(kind=4), intent(in) :: a
+    real4_argument = a
+end function
+
+integer(kind=4) function return_constant()
+    return_constant = 17
+end function
+
+character(40) function return_string()
+    return_string='returned in hidden first argument'
+end function
+
+recursive function fibonacci(n) result(item)
+    integer(kind=4) :: item
+    integer(kind=4), intent(in) :: n
+    select case (n)
+        case (0:1)
+            item = n
+        case default
+            item = fibonacci(n-1) + fibonacci(n-2)
+    end select
+end function
+
+complex(kind=16) function complex_argument(a)
+    complex(kind=16), intent(in) :: a
+    complex_argument = a
+end function
+
+integer(kind=4) function array_function(a)
+    integer(kind=4), dimension(11) :: a
+    array_function = a(ubound(a, 1, 4))
+end function
+
+integer(kind=4) function pointer_function(int_pointer)
+    integer, pointer :: int_pointer
+    pointer_function = int_pointer
+end function
+
+integer(kind=4) function hidden_string_length(string)
+  character*(*) :: string
+  hidden_string_length = len(string)
+end function
+
+integer(kind=4) function sum_some(a, b, c)
+    integer :: a, b
+    integer, optional :: c
+    sum_some = a + b
+    if (present(c)) then
+        sum_some = sum_some + c
+    end if
+end function
+
+module derived_types_and_module_calls
+    type cart
+        integer :: x
+        integer :: y
+    end type
+    type cart_nd
+        integer :: x
+        integer, allocatable :: d(:)
+    end type
+    type nested_cart_3d
+        type(cart) :: d
+        integer :: z
+    end type
+contains
+    type(cart) function pass_cart(c)
+        type(cart) :: c
+        pass_cart = c
+    end function
+    integer(kind=4) function pass_cart_nd(c)
+        type(cart_nd) :: c
+        pass_cart_nd = ubound(c%d,1,4)
+    end function
+    type(nested_cart_3d) function pass_nested_cart(c)
+        type(nested_cart_3d) :: c
+        pass_nested_cart = c
+    end function
+    type(cart) function build_cart(x,y)
+        integer :: x, y
+        build_cart%x = x
+        build_cart%y = y
+    end function
+end module
+
+program function_calls
+    use derived_types_and_module_calls
+    implicit none
+    interface
+        logical function no_arg()
+        end function
+        logical function one_arg(x)
+            logical, intent(in) :: x
+        end function
+        integer(kind=4) function pointer_function(int_pointer)
+            integer, pointer :: int_pointer
+        end function
+        integer(kind=4) function several_arguments(a, b, c)
+            integer(kind=4), intent(in) :: a
+            integer(kind=4), intent(in) :: b
+            integer(kind=4), intent(in) :: c
+        end function
+        complex(kind=16) function complex_argument(a)
+            complex(kind=16), intent(in) :: a
+        end function
+            real(kind=4) function real4_argument(a)
+            real(kind=4), intent(in) :: a
+        end function
+        integer(kind=4) function return_constant()
+        end function
+        character(40) function return_string()
+        end function
+        integer(kind=4) function one_arg_value(x)
+            integer(kind=4), value :: x
+        end function
+        integer(kind=4) function sum_some(a, b, c)
+            integer :: a, b
+            integer, optional :: c
+        end function
+        integer(kind=4) function mix_of_scalar_arguments(a, b, c)
+            integer(kind=4), intent(in) :: a
+            logical(kind=4), intent(in) :: b
+            real(kind=8), intent(in) :: c
+        end function
+        integer(kind=4) function array_function(a)
+            integer(kind=4), dimension(11) :: a
+        end function
+        integer(kind=4) function hidden_string_length(string)
+            character*(*) :: string
+        end function
+    end interface
+    logical :: untrue, no_arg_return
+    complex(kind=16) :: fft, fft_result
+    integer(kind=4), dimension (11) :: integer_array
+    real(kind=8) :: real8
+    real(kind=4) :: real4
+    integer, pointer :: int_pointer
+    integer, target :: pointee, several_arguments_return
+    integer(kind=4) :: integer_return
+    type(cart) :: c, cout
+    type(cart_nd) :: c_nd
+    type(nested_cart_3d) :: nested_c
+    character(40) :: returned_string, returned_string_debugger
+    real8 = 3.00
+    real4 = 9.3
+    integer_array = 17
+    fft = cmplx(2.1, 3.3, 16)
+    print *, fft
+    untrue = .FALSE.
+    int_pointer => pointee
+    pointee = 87
+    c%x = 2
+    c%y = 4
+    c_nd%x = 4
+    allocate(c_nd%d(4))
+    c_nd%d = 6
+    nested_c%z = 3
+    nested_c%d%x = 1
+    nested_c%d%y = 2
+    ! Use everything so it is not elided by the compiler.
+    call no_arg_subroutine()
+    no_arg_return = no_arg() .AND. one_arg(.FALSE.)
+    several_arguments_return = several_arguments(1,2,3) + return_constant()
+    integer_return = array_function(integer_array)
+    integer_return = mix_of_scalar_arguments(2, untrue, real8)
+    real4 = real4_argument(3.4)
+    integer_return = pointer_function(int_pointer)
+    c = pass_cart(c)
+    integer_return = pass_cart_nd(c_nd)
+    nested_c = pass_nested_cart(nested_c)
+    integer_return = hidden_string_length('string of implicit length')
+    call run(no_arg_subroutine)
+    integer_return = one_arg_value(10)
+    integer_return = sum_some(1,2,3)
+    returned_string = return_string()
+    cout = build_cart(4,5)
+    fft_result = complex_argument(fft)
+    print *, cout
+    print *, several_arguments_return
+    print *, fft_result
+    print *, real4
+    print *, integer_return
+    print *, returned_string_debugger
+    deallocate(c_nd%d) ! post_init
+end program
--
2.7.4
Reply | Threaded
Open this post in threaded view
|

Re: [PATCH] Fortran function calls with arguments

Simon Marchi-2
On 2019-01-21 10:05 a.m., Richard Bunt wrote:

> Prior to this patch, calling functions on the inferior with arguments and
> then using these arguments within a function resulted in an invalid
> memory access. This is because Fortran arguments are typically passed as
> pointers to values.
>
> It is possible to call Fortran functions, but memory must be allocated in
> the inferior, so a pointer can be passed to the function, and the
> language must be set to C to enable C-style casting. This is cumbersome
> and not a pleasant debug experience.
>
> This patch implements the GNU Fortran argument passing conventions with
> caveats. Firstly, it does not handle the VALUE attribute as there is
> insufficient DWARF information to determine when this is the case.
> Secondly, functions with optional parameters can only be called with all
> parameters present. Both these cases are marked as KFAILS in the test.
>
> Since the GNU Fortran argument passing convention has been implemented,
> there is no guarantee that this patch will work correctly, in all cases,
> with other compilers.
>
> Despite these limitations, this patch improves the ease with which
> functions can be called in many cases, without taking away the existing
> approach of calling with the language set to C.
>
> It should be noted that bugs were found with printing complex numbers
> while developing this patch. However, fixing this issue was considered
> outside the scope of this patch. The test case for calling functions with
> complex numbers should remain as a KFAIL.
>
> Regression tested on x86_64, aarch64 and POWER9 with GCC 7.3.0.
> Regression tested with Ada on x86_64.
> Regression tested with native-extended-gdbserver target board.

Hi Richard,

Thanks for the patch.  I don't know Fortran, so I can't assess whether the
behavior you implement is the right one.  If other maintainers have this
knowledge, they are welcome to complement this review.  Otherwise, I am
ready to trust you on that matter.

Here are a few more high level comments in the mean time.

> gdb/ChangeLog:
> 2018-10-27  Richard Bunt  <[hidden email]>
> Dirk Schubert  <[hidden email]>
> Chris January  <[hidden email]>
>
> * gdb/eval.c (evaluate_subexp_standard): Call Fortran argument
> wrapping logic.
> * gdb/f-lang.c (struct value): A value which can be passed into a
> Fortran function call.
> (fortran_argument_convert): Wrap Fortran arguments in a pointer
> where appropriate.
> (struct type): Value ready for a Fortran function call.
> (fortran_preserve_arg_pointer): Undo check_typedef, the pointer
> is needed.
> * gdb/f-lang.h (fortran_argument_convert): Declaration.
> (fortran_preserve_arg_pointer): Declaration.
> * gdb/infcall.c (value_arg_coerce): Call Fortran argument
> logic.

Remove the gdb/ prefixes (the filenames should be relative to the ChangeLog
file itself).

>
> gdb/testsuite/ChangeLog:
> 2018-10-27  Richard Bunt  <[hidden email]>
>
> * gdb/testsuite/gdb.fortran/function-calls.exp: New file.
> * gdb/testsuite/gdb.fortran/function-calls.f90: New test.

Same here.

> ---
>  gdb/eval.c                                   |  13 +-
>  gdb/f-lang.c                                 |  48 ++++++
>  gdb/f-lang.h                                 |   5 +-
>  gdb/infcall.c                                |   5 +-
>  gdb/testsuite/gdb.fortran/function-calls.exp | 104 ++++++++++++
>  gdb/testsuite/gdb.fortran/function-calls.f90 | 242 +++++++++++++++++++++++++++
>  6 files changed, 414 insertions(+), 3 deletions(-)
>  create mode 100644 gdb/testsuite/gdb.fortran/function-calls.exp
>  create mode 100644 gdb/testsuite/gdb.fortran/function-calls.f90
>
> diff --git a/gdb/eval.c b/gdb/eval.c
> index 47d08a656c0229ace5f2004f73eabb30c90a96a8..083e9531e103ba995910c26c12e4961024dab3b8 100644
> --- a/gdb/eval.c
> +++ b/gdb/eval.c
> @@ -1987,7 +1987,18 @@ evaluate_subexp_standard (struct type *expect_type,
>    argvec[0] = arg1;
>    tem = 1;
>    for (; tem <= nargs; tem++)
> -    argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
> +    {
> +      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.  */
> +      argvec[tem] = fortran_argument_convert (argvec[tem],
> + TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem-1));

Spaces are the minus sign.

Normally, when wrapping arguments, the wrapped ones should be aligned with the
first one (according to the GNU style).  It's a bit hard here because of the length
of the expression and the fact that we are pretty nested.  To solve it, I would do:

              bool is_artifical
                = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
              argvec[tem] = fortran_argument_convert (argvec[tem], is_artificial);

> +    }
>    argvec[tem] = 0; /* signal end of arglist */
>    if (noside == EVAL_SKIP)
>      return eval_skip_value (exp);
> diff --git a/gdb/f-lang.c b/gdb/f-lang.c
> index 4ff828ba75300ae5667313e74cfb9fcaffa9df2f..0c3118a511d55b20cb287a9e69fccb476579391c 100644
> --- a/gdb/f-lang.c
> +++ b/gdb/f-lang.c
> @@ -27,6 +27,7 @@
>  #include "parser-defs.h"
>  #include "language.h"
>  #include "varobj.h"
> +#include "gdbcore.h"
>  #include "f-lang.h"
>  #include "valprint.h"
>  #include "value.h"
> @@ -371,3 +372,50 @@ _initialize_f_language (void)
>  {
>    f_type_data = gdbarch_data_register_post_init (build_fortran_types);
>  }
> +
> +/* Ensures that function argument VALUE is in the appropriate form to
> +   pass to a Fortran function.  Returns a possibly new value that should
> +   be used instead of VALUE.
> +
> +   When IS_ARTIFICIAL is true this indicates an artificial argument,
> +   e.g. hidden string lengths which the GNU Fortran argument passing
> +   convention specifies as being passed by value.
> +
> +   When IS_ARTIFICIAL is false, the argument is passed by pointer.  If the
> +   value is already in target memory then return a value that is a pointer
> +   to VALUE.  If VALUE is not in memory (e.g. an integer literal), allocate
> +   space in the target, copy VALUE in, and return a pointer to the in
> +   memory copy.  */

Please move the comment to f-lang.h, and put this here:

/* See f-lang.h.  */

> +struct value *
> +fortran_argument_convert (struct value *value, const bool is_artificial)
> +{
> +  if (!is_artificial)
> +    {
> +      if (VALUE_LVAL (value) == not_lval
> +  || VALUE_LVAL (value) == lval_internalvar)

Just wondering, have you considered all lval_types here?  If you were to pass
a variable that is in a register (lval_register) or composed of multiple pieces
(lval_computed), I guess we would need to allocate them too.  Not sure about the
other ones.  In fact, everything that is not lval_memory would likely hit this
assert in value_addr:

  if (VALUE_LVAL (arg1) != lval_memory)
    error (_("Attempt to take address of value not located in memory."));

So maybe this should be

    if (VALUE_LVAL (value) != lval_memory)

?

> + {
> +  struct value *val = value_copy (value);
> +  const int length = TYPE_LENGTH (value_type (val));
> +  const CORE_ADDR addr
> +    = value_as_long (value_allocate_space_in_inferior (length));
> +  VALUE_LVAL (val) = lval_memory;
> +  set_value_address (val, addr);
> +  write_memory (addr, value_contents (val), length);
> +  return value_addr (val);

> + }
> +      else
> + return value_addr (value);
> +    }
> +    return value;
> +}
> +
> +/* All arguments in Fortran are pointers.  If it is a pointer, preserve it so
> +   that the address is passed rather than the value.  */

Same (move comment to f-lang.h).  Also, can you describe what ARG and TYPE are?
How are they related?

> +struct type *
> +fortran_preserve_arg_pointer (struct value *arg,
> +      struct type *type)
> +{
> +  if (TYPE_CODE (value_type (arg)) == TYPE_CODE_PTR)
> +    return value_type (arg);
> +  return type;
> +}
> diff --git a/gdb/f-lang.h b/gdb/f-lang.h
> index cab06f9806d4bed15f73b4c8da717d1ede2a7d5f..bccf082dae4c306c57b49f6a91306fc76ba3de54 100644
> --- a/gdb/f-lang.h
> +++ b/gdb/f-lang.h
> @@ -78,4 +78,7 @@ struct builtin_f_type
>  
>  /* Return the Fortran type table for the specified architecture.  */
>  extern const struct builtin_f_type *builtin_f_type (struct gdbarch *gdbarch);
> -
> +extern struct value *fortran_argument_convert (struct value *value,
> +       const bool is_artificial);
> +extern struct type *fortran_preserve_arg_pointer (struct value *arg,
> +  struct type *type);
> diff --git a/gdb/infcall.c b/gdb/infcall.c
> index 14b0cbc716907ac790fd9c4fee89172fa2a33020..367048b7411900486855ddac5949aa655ea77853 100644
> --- a/gdb/infcall.c
> +++ b/gdb/infcall.c
> @@ -33,6 +33,7 @@
>  #include "command.h"
>  #include "dummy-frame.h"
>  #include "ada-lang.h"
> +#include "f-lang.h"
>  #include "gdbthread.h"
>  #include "event-top.h"
>  #include "observable.h"
> @@ -129,7 +130,7 @@ show_unwind_on_terminating_exception_p (struct ui_file *file, int from_tty,
>  }
>  
>  /* Perform the standard coercions that are specified
> -   for arguments to be passed to C or Ada functions.
> +   for arguments to be passed to C, Ada or Fortran functions.
>  
>     If PARAM_TYPE is non-NULL, it is the expected parameter type.
>     IS_PROTOTYPED is non-zero if the function declaration is prototyped.
> @@ -148,6 +149,8 @@ value_arg_coerce (struct gdbarch *gdbarch, struct value *arg,
>    /* Perform any Ada-specific coercion first.  */
>    if (current_language->la_language == language_ada)
>      arg = ada_convert_actual (arg, type);
> +  else if (current_language->la_language == language_fortran)
> +    type = fortran_preserve_arg_pointer (arg, type);

The comment just above would need to be updated to mention Fortran.

>  
>    /* Force the value to the target if we will need its address.  At
>       this point, we could allocate arguments on the stack instead of
> diff --git a/gdb/testsuite/gdb.fortran/function-calls.exp b/gdb/testsuite/gdb.fortran/function-calls.exp
> new file mode 100644
> index 0000000000000000000000000000000000000000..e75336651b3947534e6a11766d4fdc5fa9b87d5d
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/function-calls.exp
> @@ -0,0 +1,104 @@
> +# Copyright 2019 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/> .
> +
> +# Exercise passing and returning arguments in Fortran. This test case
> +# is based on the GNU Fortran Argument passing conventions.
> +
> +if {[skip_fortran_tests]} { return -1 }
> +
> +standard_testfile ".f90"
> +
> +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} {debug f90}]} {
> +    return -1
> +}
> +
> +if {![runto [gdb_get_line_number "post_init"]]} then {
> +    perror "couldn't run to breakpoint post_init"
> +    continue
> +}
> +
> +# Use inspired by gdb.base/callfuncs.exp.
> +gdb_test_no_output "set unwindonsignal on"
> +
> +# Baseline: function and subroutine call with no arguments.
> +gdb_test "p no_arg()" " = .TRUE."
> +gdb_test_no_output "call no_arg_subroutine()"
> +
> +# Argument class: literal, inferior variable, convenience variable,
> +# function call return value, function.
> +# Paragraph 3: Variables are passed by reference.
> +gdb_test "p one_arg(.TRUE.)" " = .TRUE."
> +gdb_test "p one_arg(untrue)" " = .FALSE."
> +gdb_test_no_output "set \$var = .FALSE."
> +gdb_test "p one_arg(\$var)" " = .FALSE."
> +gdb_test "p one_arg(one_arg(.TRUE.))" " = .TRUE."
> +gdb_test "p one_arg(one_arg(.FALSE.))" " = .FALSE."
> +gdb_test_no_output "call run(no_arg_subroutine)"
> +
> +# Return: constant.
> +gdb_test "p return_constant()" " = 17"
> +# Return derived type and call a function in a module.
> +gdb_test "p derived_types_and_module_calls::build_cart(7,8)" \
> + " = \\\( x = 7, y = 8 \\\)"
> +
> +# Two hidden arguments. 1. returned string and 2. string length.
> +# Paragraph 1.
> +gdb_test "p return_string(returned_string_debugger, 40)" ""
> +gdb_test "p returned_string_debugger" "'returned in hidden first argument       '"
> +
> +# Argument type: real(kind=4), complex, array, pointer, derived type,
> +# derived type with allocatable, nested derived type.
> +# Paragraph 4: pointer.
> +gdb_test "p pointer_function(int_pointer)" " = 87"
> +# Paragraph 4: array.
> +gdb_test "call array_function(integer_array)" " = 17"
> +gdb_test "p derived_types_and_module_calls::pass_cart(c)" \
> + " = \\\( x = 2, y = 4 \\\)"
> +# Allocatable elements in a derived type. Technical report ISO/IEC 15581.
> +gdb_test "p derived_types_and_module_calls::pass_cart_nd(c_nd)" " = 4"
> +gdb_test "p derived_types_and_module_calls::pass_nested_cart(nested_c)" \
> +  "= \\\( d = \\\( x = 1, y = 2 \\\), z = 3 \\\)"
> +# Result within some tolerance.
> +gdb_test "p real4_argument(real4)" " = 3.${decimal}"
> +
> +# Printing complex numbers through GDB doesn't work in general.
> +# Paragraph 2.
> +setup_kfail "gdb/NNNN" *-*-*
> +gdb_test "p complex_argument(fft)" " = (2.${decimal},3.${decimal})"
> +
> +# Function with optional arguments.
> +# Paragraph 10: Option reference arguments.
> +gdb_test "p sum_some(1,2,3)" " = 6"
> +# There is currently no mechanism to call a function without all
> +# optional parameters present.
> +setup_kfail "gdb/NNNN" *-*-*
> +gdb_test "p sum_some(1,2)" " = 3"
> +
> +# Paragraph 10: optional value arguments. There is insufficient DWARF
> +# information to reliably make this case work.
> +setup_kfail "gdb/NNNN" *-*-*
> +gdb_test "p one_arg_value(10)" " = 10"
> +
> +# DW_AT_artificial formal parameters must be passed manually. This
> +# assert will fail if the length of the string is wrapped in a pointer.
> +# Paragraph 7: Character type.
> +gdb_test "p hidden_string_length('arbitrary string', 16)" " = 16"
> +
> +# Several arguments.
> +gdb_test "p several_arguments(2, 3, 5)" " = 10"
> +gdb_test "p mix_of_scalar_arguments(5, .TRUE., 3.5)" " = 9"
> +
> +# Calling other functions: Recursive call.
> +gdb_test "p fibonacci(6)" " = 8"

Could you file bugs for the various setup_kfail?

Thanks,

Simon
Reply | Threaded
Open this post in threaded view
|

Re: [PATCH] Fortran function calls with arguments

Richard Bunt
Hi Simon,

Many thanks for the review comments.

On 1/21/19 10:03 PM, Simon Marchi wrote:
>
> Thanks for the patch.  I don't know Fortran, so I can't assess whether the
> behavior you implement is the right one.  If other maintainers have this
> knowledge, they are welcome to complement this review.  Otherwise, I am
> ready to trust you on that matter.

My definition of correct for this patch has been gleaned from two sources:

1. The GNU Fortran argument passing conventions which can be found here:

https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html

I've attempted to capture as much of this page as possible in the test case.

2. Valid source code. A user should be able to paste their Fortran function
call from their source code into GDB and receive the expected result.

>
> Here are a few more high level comments in the mean time.
>

I've addressed all style and code/comment repositioning issues for v2 of
the patch.

>
>> +struct value *
>> +fortran_argument_convert (struct value *value, const bool is_artificial)
>> +{
>> +  if (!is_artificial)
>> +    {
>> +      if (VALUE_LVAL (value) == not_lval
>> +  || VALUE_LVAL (value) == lval_internalvar)
>
> Just wondering, have you considered all lval_types here?  If you were to pass
> a variable that is in a register (lval_register) or composed of multiple pieces
> (lval_computed), I guess we would need to allocate them too.  Not sure about the
> other ones.  In fact, everything that is not lval_memory would likely hit this
> assert in value_addr:
>
>   if (VALUE_LVAL (arg1) != lval_memory)
>     error (_("Attempt to take address of value not located in memory."));
>
> So maybe this should be
>
>     if (VALUE_LVAL (value) != lval_memory)
>
> ?
>

Yes, this makes more sense. That error is indeed hit if a function call is made
where one of the arguments is a register. v2 of this patch now works in this case.

I am not able to see how the user would be able to express the other types of
lvalue (e.g. computed) from the user interface. Do you have any pointers on
this? As it would be useful to add this to the test case if it is indeed possible
for the user to provoke this.

>
> Same (move comment to f-lang.h).  Also, can you describe what ARG and TYPE are?
> How are they related?
>

>
> Could you file bugs for the various setup_kfail?
>

I've filed the bug report for the optional attribute here:

https://sourceware.org/bugzilla/show_bug.cgi?id=24147

However, I think the second bug report should wait until the point this
patch passes review, as the bug only exists in GDB HEAD with this patch applied.
I've included what the bug report would consist of below to explain why this
bug exists.

Fortran allows function parameters to be tagged with a "value" attribute which
indicates that an argument is to be passed by value, rather than the default
of by reference. For example:

{noformat}
integer(kind=4) function one_arg_value(x)
    integer(kind=4), value :: x
    one_arg_value = x
end function
{noformat}

p one_arg_value(10)
$19 = 6318016

Garbage is returned when this function is called with a version of GDB which
has this patch applied. Most likely this is the location of 10 in the inferior
placed into a 4-byte integer, since GDB is passing a pointer to this value
rather than the value. NOTE: This use case will work on GDB without this patch
applied, as it flips the default calling convention to that outlined in
https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html. This
way functions calls will mostly work out of the box rather than mostly not work.

If this function call was working as expected it would return 10.

This was tested with:
* A build of 36c25ffa1ab5d6d5ee0fa3fc32f128a58e78e7a2 + the following patch
from the mailing list https://sourceware.org/ml/gdb-patches/2019-01/msg00448.html
* On Ubuntu 16.04.
* On x86 64.
* Fortran programs compiled with GCC 8.2.


Many thanks,

Rich
Reply | Threaded
Open this post in threaded view
|

Re: [PATCH] Fortran function calls with arguments

Simon Marchi-2
On 2019-01-29 9:47 a.m., Richard Bunt wrote:

> Hi Simon,
>
> Many thanks for the review comments.
>
> On 1/21/19 10:03 PM, Simon Marchi wrote:
>>
>> Thanks for the patch.  I don't know Fortran, so I can't assess whether the
>> behavior you implement is the right one.  If other maintainers have this
>> knowledge, they are welcome to complement this review.  Otherwise, I am
>> ready to trust you on that matter.
>
> My definition of correct for this patch has been gleaned from two sources:
>
> 1. The GNU Fortran argument passing conventions which can be found here:
>
> https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html
>
> I've attempted to capture as much of this page as possible in the test case.
>
> 2. Valid source code. A user should be able to paste their Fortran function
> call from their source code into GDB and receive the expected result.
>
>>
>> Here are a few more high level comments in the mean time.
>>
>
> I've addressed all style and code/comment repositioning issues for v2 of
> the patch.

Thanks!

>>
>>> +struct value *
>>> +fortran_argument_convert (struct value *value, const bool is_artificial)
>>> +{
>>> +  if (!is_artificial)
>>> +    {
>>> +      if (VALUE_LVAL (value) == not_lval
>>> +  || VALUE_LVAL (value) == lval_internalvar)
>>
>> Just wondering, have you considered all lval_types here?  If you were to pass
>> a variable that is in a register (lval_register) or composed of multiple pieces
>> (lval_computed), I guess we would need to allocate them too.  Not sure about the
>> other ones.  In fact, everything that is not lval_memory would likely hit this
>> assert in value_addr:
>>
>>   if (VALUE_LVAL (arg1) != lval_memory)
>>     error (_("Attempt to take address of value not located in memory."));
>>
>> So maybe this should be
>>
>>     if (VALUE_LVAL (value) != lval_memory)
>>
>> ?
>>
>
> Yes, this makes more sense. That error is indeed hit if a function call is made
> where one of the arguments is a register. v2 of this patch now works in this case.
>
> I am not able to see how the user would be able to express the other types of
> lvalue (e.g. computed) from the user interface. Do you have any pointers on
> this? As it would be useful to add this to the test case if it is indeed possible
> for the user to provoke this.

lval_computed is not something you can simply trigger from the command line, I believe.

It's used when the compiler optimizes and decides to place parts of a value in different
places.  For example (maybe a bit exaggerated), for an 8 bytes value, it could put the
first 3 in memory, the next 4 in a register, and the last one is optimized out.  The location
of this value will be described by DWARF "pieces", which is essentially a sequence of
DWARF opcodes describing sequentially where all the pieces are.  The value in GDB with be
lval_computed.  You can check section "2.6.1.2 Composite Location Descriptions" of DWARF5.pdf
if you want to know more.

It's a bit tricky to test, because you need to need to generate predictable DWARF pieces.
The best way is probably to write the DWARF by hand, as in testsuite/gdb.dwarf2/var-access.exp.

Maybe it would be a bit overkill to include such a test in your test case, I'll let you decide
if it's worth it.

lval_xcallable refers to XMethods:

  https://sourceware.org/gdb/onlinedocs/gdb/Xmethods-In-Python.html#Xmethods-In-Python

For lval_internalvar_component, the comment says "Part of a gdb internal variable (structure field)",
so I assume you need to have a structure in a GDB internal variable (set $foo = ...) and pass a field
of $foo to the function.

>
>> Same (move comment to f-lang.h).  Also, can you describe what ARG and TYPE are?
>> How are they related?
>>
>
>>
>> Could you file bugs for the various setup_kfail?
>>
>
> I've filed the bug report for the optional attribute here:
>
> https://sourceware.org/bugzilla/show_bug.cgi?id=24147
>
> However, I think the second bug report should wait until the point this
> patch passes review, as the bug only exists in GDB HEAD with this patch applied.
> I've included what the bug report would consist of below to explain why this
> bug exists.

Yes, that's fine.

> Fortran allows function parameters to be tagged with a "value" attribute which
> indicates that an argument is to be passed by value, rather than the default
> of by reference. For example:
>
> {noformat}
> integer(kind=4) function one_arg_value(x)
>     integer(kind=4), value :: x
>     one_arg_value = x
> end function
> {noformat}
>
> p one_arg_value(10)
> $19 = 6318016
>
> Garbage is returned when this function is called with a version of GDB which
> has this patch applied. Most likely this is the location of 10 in the inferior
> placed into a 4-byte integer, since GDB is passing a pointer to this value
> rather than the value. NOTE: This use case will work on GDB without this patch
> applied, as it flips the default calling convention to that outlined in
> https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html. This
> way functions calls will mostly work out of the box rather than mostly not work.
>
> If this function call was working as expected it would return 10.
>
> This was tested with:
> * A build of 36c25ffa1ab5d6d5ee0fa3fc32f128a58e78e7a2 + the following patch
> from the mailing list https://sourceware.org/ml/gdb-patches/2019-01/msg00448.html
> * On Ubuntu 16.04.
> * On x86 64.
> * Fortran programs compiled with GCC 8.2.


Thanks,

Simon