diff mbox

[6/8] gdb/fortran: print function arguments when printing function type

Message ID feead5449784fea12a94cad3c1f2972de7e8e5d9.1552913184.git.andrew.burgess@embecosm.com
State New
Headers show

Commit Message

Andrew Burgess March 18, 2019, 12:52 p.m. UTC
gdb/ChangeLog:

	* f-typeprint.c (f_type_print_varspec_suffix): Handle printing
	function arguments.

gdb/testsuite/ChangeLog:

	* gdb.fortran/ptype-on-functions.exp: New file.
	* gdb.fortran/ptype-on-functions.f90: New file.
---
 gdb/ChangeLog                                     |  6 ++
 gdb/f-typeprint.c                                 | 27 +++++++--
 gdb/testsuite/ChangeLog                           |  5 ++
 gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp |  2 +-
 gdb/testsuite/gdb.fortran/ptype-on-functions.exp  | 45 ++++++++++++++
 gdb/testsuite/gdb.fortran/ptype-on-functions.f90  | 74 +++++++++++++++++++++++
 6 files changed, 153 insertions(+), 6 deletions(-)
 create mode 100644 gdb/testsuite/gdb.fortran/ptype-on-functions.exp
 create mode 100644 gdb/testsuite/gdb.fortran/ptype-on-functions.f90
diff mbox

Patch

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index d8f752f6808..0a84aea84af 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,9 @@ 
+2019-03-18  Andrew Burgess  <andrew.burgess@embecosm.com>
+	    Chris January  <chris.january@arm.com>
+
+	* f-typeprint.c (f_type_print_varspec_suffix): Handle printing
+	function arguments.
+
 2019-03-18  Andrew Burgess  <andrew.burgess@embecosm.com>
 
 	* f-lang.c (build_fortran_types): Change name of void type to
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 7e36ca16c69..c89816f7a39 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -226,12 +226,29 @@  f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
       break;
 
     case TYPE_CODE_FUNC:
-      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
-				   passed_a_ptr, 0, arrayprint_recurse_level);
-      if (passed_a_ptr)
-	fprintf_filtered (stream, ")");
+      {
+	int i, nfields = TYPE_NFIELDS (type);
 
-      fprintf_filtered (stream, "()");
+	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+				     passed_a_ptr, 0, arrayprint_recurse_level);
+	if (passed_a_ptr)
+	  fprintf_filtered (stream, ")");
+	fprintf_filtered (stream, "(");
+	if (nfields == 0 && TYPE_PROTOTYPED (type))
+	  f_print_type (builtin_f_type (get_type_arch (type))->builtin_void,
+			"", stream, -1, 0, 0);
+	else
+	  for (i = 0; i < nfields; i++)
+	    {
+	      if (i > 0)
+		{
+		  fputs_filtered (", ", stream);
+		  wrap_here ("    ");
+		}
+	      f_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0, 0);
+	    }
+	fprintf_filtered (stream, ")");
+      }
       break;
 
     case TYPE_CODE_UNDEF:
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 3cdc3cfa6fc..931ed5a348b 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,8 @@ 
+2019-03-18  Andrew Burgess  <andrew.burgess@embecosm.com>
+
+	* gdb.fortran/ptype-on-functions.exp: New file.
+	* gdb.fortran/ptype-on-functions.f90: New file.
+
 2019-03-18  Andrew Burgess  <andrew.burgess@embecosm.com>
 
 	* gdb.fortran/exprs.exp (test_convenience_variables): Expect lower
diff --git a/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp b/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp
index 2824e16bf34..ce24854a35b 100644
--- a/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp
+++ b/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp
@@ -45,7 +45,7 @@  gdb_test "set case-sensitive off" {warning: the current case sensitivity setting
 # Note that info functions gives the FUNC_lang result using the fortran syntax
 # as specified in dw-case-insensitive-debug.S DW_AT_language.
 gdb_test "info functions fUnC_lang" \
-	 "All functions matching regular expression \"fUnC_lang\":\[\r\n\]+File file1.txt:\r\n\tfoo FUNC_lang\\(\\);(\r\n\r\nNon-debugging symbols:\r\n0x\[0-9a-f\]+ +\\.FUNC_lang)?" \
+	 "All functions matching regular expression \"fUnC_lang\":\[\r\n\]+File file1.txt:\r\n\tfoo FUNC_lang\\(void\\);(\r\n\r\nNon-debugging symbols:\r\n0x\[0-9a-f\]+ +\\.FUNC_lang)?" \
 	 "regexp case-sensitive off"
 
 gdb_test "p fuNC_lang" { = {foo \(void\)} 0x[0-9a-f]+ <FUNC_lang>}
diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
new file mode 100644
index 00000000000..4ce78623b47
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
@@ -0,0 +1,45 @@ 
+# 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/>.
+
+# This file contains a test for printing the types of functions.
+
+if { [skip_fortran_tests] } { return -1 }
+
+standard_testfile .f90
+load_lib "fortran.exp"
+
+if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90}]} {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+gdb_test "ptype some_module::get_number" \
+    "type = integer\\(kind=4\\) \\(Type __class_some_module_Number_t\\)"
+
+gdb_test "ptype some_module::set_number" \
+    "type = void \\(Type __class_some_module_Number_t, integer\\(kind=4\\)\\)"
+
+gdb_test "ptype is_bigger" \
+    "type = logical\\(kind=4\\) \\(integer\\(kind=4\\), integer\\(kind=4\\)\\)"
+
+gdb_test "ptype say_numbers" \
+    "type = void \\(integer\\(kind=4\\), integer\\(kind=4\\), integer\\(kind=4\\)\\)"
+
+gdb_test "ptype fun_ptr" \
+    "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\)\\(REF TO -> \\( integer\\(kind=4\\) \\)\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.f90 b/gdb/testsuite/gdb.fortran/ptype-on-functions.f90
new file mode 100644
index 00000000000..bb8e0a6f825
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.f90
@@ -0,0 +1,74 @@ 
+module some_module
+  implicit none
+
+  type, public :: Number
+     integer :: a
+   contains
+     procedure :: get => get_number
+     procedure :: set => set_number
+  end type Number
+
+contains
+
+  function get_number (this) result (val)
+    class (Number), intent (in) :: this
+    integer :: val
+    val = this%a
+  end function get_number
+
+  subroutine set_number (this, val)
+    class (Number), intent (inout) :: this
+    integer :: val
+    this%a = val
+  end subroutine set_number
+
+end module some_module
+
+logical function is_bigger (a,b)
+  integer, intent(in) :: a
+  integer, intent(in) :: b
+  is_bigger = a > b
+end function is_bigger
+
+subroutine say_numbers (v1,v2,v3)
+  integer,intent(in) :: v1
+  integer,intent(in) :: v2
+  integer,intent(in) :: v3
+  print *, v1,v2,v3
+end subroutine say_numbers
+
+program test
+  use some_module
+
+  interface
+     integer function fun1 (x)
+       integer :: x
+     end function fun1
+
+     integer function fun2 (x)
+       integer :: x
+     end function fun2
+  end interface
+
+  type (Number) :: n1
+  type (Number) :: n2
+
+  procedure(fun1), pointer:: fun_ptr => NULL()
+
+  call say_numbers (1,2,3)	! stop here
+  print *, fun_ptr (3)
+
+end program test
+
+integer function fun1 (x)
+  implicit none
+  integer :: x
+  fun1 = x + 1
+end function fun1
+
+integer function fun2 (x)
+  implicit none
+  integer :: x
+  fun2 = x + 2
+end function fun2
+