From patchwork Mon Mar 18 12:52:21 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andrew Burgess X-Patchwork-Id: 31886 Received: (qmail 23406 invoked by alias); 18 Mar 2019 12:52:45 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 23303 invoked by uid 89); 18 Mar 2019 12:52:44 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-19.0 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=sensitivity, REF X-HELO: mail-wr1-f65.google.com Received: from mail-wr1-f65.google.com (HELO mail-wr1-f65.google.com) (209.85.221.65) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 18 Mar 2019 12:52:41 +0000 Received: by mail-wr1-f65.google.com with SMTP id d17so16896709wre.10 for ; Mon, 18 Mar 2019 05:52:40 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=embecosm.com; s=google; h=from:to:cc:subject:date:message-id:in-reply-to:references :in-reply-to:references; bh=CFNO8ZW7PPM9ys3yhT4fBX2ZYfuHN80uUY0krie99Kg=; b=Q+4udLu33qwBPj3iKowdy9MMSPi4YbBqpESYeo9tBhVtFfVJjOhzlc3qAbbMnweA/K +Q19+1G9P3uVwmWfs6zM30xEsAL9I0HcBpvdyOZWIvnympYMMrsVNpdQPz8kOv/U3X59 MMIlZQz7c/wKIxECX9RWIhYwvEAVb9o7OrEpVQgGVd9QyNpk7Oc4Li7LYO6jURO7/mk5 NCvLI1Ext9WtO0Bb0E3lOUbV0O1I+8bF7yCSq4rPxgPzHmm2mQ4d8fAqO969bu+IFJnK H6L8NWvY1bWSzwLDtvQjGorMj/ejqjvyAT4SiK5HEavsvAUwa4O9CROXxT1JbjnnPM5n jD9Q== Return-Path: Received: from localhost (host86-142-70-198.range86-142.btcentralplus.com. [86.142.70.198]) by smtp.gmail.com with ESMTPSA id b9sm11345470wmc.9.2019.03.18.05.52.37 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Mon, 18 Mar 2019 05:52:37 -0700 (PDT) From: Andrew Burgess To: gdb-patches@sourceware.org Cc: Richard Bunt , Andrew Burgess Subject: [PATCH 6/8] gdb/fortran: print function arguments when printing function type Date: Mon, 18 Mar 2019 12:52:21 +0000 Message-Id: In-Reply-To: References: In-Reply-To: References: X-IsSubscribed: yes 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 --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 + Chris January + + * f-typeprint.c (f_type_print_varspec_suffix): Handle printing + function arguments. + 2019-03-18 Andrew Burgess * 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 + + * gdb.fortran/ptype-on-functions.exp: New file. + * gdb.fortran/ptype-on-functions.f90: New file. + 2019-03-18 Andrew Burgess * 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]+ } 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 . + +# 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 +