From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 26380 invoked by alias); 27 Oct 2005 12:10:40 -0000 Mailing-List: contact gdb-patches-help@sources.redhat.com; run by ezmlm Precedence: bulk List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sources.redhat.com Received: (qmail 26265 invoked by uid 22791); 27 Oct 2005 12:10:31 -0000 Received: from ausmtp01.au.ibm.com (HELO ausmtp01.au.ibm.com) (202.81.18.186) by sourceware.org (qpsmtpd/0.30-dev) with ESMTP; Thu, 27 Oct 2005 12:10:31 +0000 Received: from sd0112e0.au.ibm.com (d23rh903.au.ibm.com [202.81.18.201]) by ausmtp01.au.ibm.com (8.12.10/8.12.10) with ESMTP id j9RC4LP8393384 for ; Thu, 27 Oct 2005 22:13:34 +1000 Received: from d23av03.au.ibm.com (d23av03.au.ibm.com [9.190.250.244]) by sd0112e0.au.ibm.com (8.12.10/NCO/VERS6.7) with ESMTP id j9R6wtQb094726 for ; Thu, 27 Oct 2005 16:58:57 +1000 Received: from d23av03.au.ibm.com (loopback [127.0.0.1]) by d23av03.au.ibm.com (8.12.11/8.13.3) with ESMTP id j9R6teFP024808 for ; Thu, 27 Oct 2005 16:55:40 +1000 Received: from [9.181.133.252] ([9.181.133.252]) by d23av03.au.ibm.com (8.12.11/8.12.11) with ESMTP id j9R6t7cI024003; Thu, 27 Oct 2005 16:55:18 +1000 Date: Thu, 27 Oct 2005 12:51:00 -0000 From: Wu Zhou To: gdb-patches@sources.redhat.com cc: fortran@gcc.gnu.org Subject: [RFC]: Patch to type and value print Fortran derived type - Fix for gfortran PR24527 Message-ID: MIME-Version: 1.0 Content-Type: TEXT/PLAIN; charset=US-ASCII X-SW-Source: 2005-10/txt/msg00209.txt.bz2 GDB don't have much support for new language features introduced after Fortran-77 standard. Derived type is in this class. Thomas Koenig opened a PR in gfortran bugzilla titled "derived types not displayed correctly with gdb". This patch is intended to fix that. Any comments and suggestion are highly appreciated. 2005-10-27 Wu Zhou * f-typeprint.c (f_type_print_base): Add some code to handle TYPE_CODE_STRUCT. * f-valprint.c (f_val_print): Ditto. Index: f-typeprint.c =================================================================== RCS file: /cvs/src/src/gdb/f-typeprint.c,v retrieving revision 1.13 diff -c -3 -p -r1.13 f-typeprint.c *** f-typeprint.c 11 Feb 2005 04:05:47 -0000 1.13 --- f-typeprint.c 27 Oct 2005 06:44:36 -0000 *************** f_type_print_base (struct type *type, st *** 288,293 **** --- 288,294 ---- { int retcode; int upper_bound; + int index; QUIT; *************** f_type_print_base (struct type *type, st *** 391,396 **** --- 392,412 ---- } break; + case TYPE_CODE_STRUCT: + fprintf_filtered (stream, "Type "); + fputs_filtered (TYPE_TAG_NAME (type), stream); + fputs_filtered ("\n", stream); + for (index = 0; index < TYPE_NFIELDS (type); index++) + { + fputs_filtered (" ", stream); + f_print_type (TYPE_FIELD_TYPE (type, index), "", stream, show, level); + fputs_filtered (" ", stream); + fputs_filtered (TYPE_FIELD_NAME (type, index), stream); + fputs_filtered ("\n", stream); + } + fprintf_filtered (stream, "End type"); + break; + default_case: default: /* Handle types not explicitly handled by the other cases, Index: f-valprint.c =================================================================== RCS file: /cvs/src/src/gdb/f-valprint.c,v retrieving revision 1.30 diff -c -3 -p -r1.30 f-valprint.c *** f-valprint.c 9 May 2005 21:20:30 -0000 1.30 --- f-valprint.c 27 Oct 2005 06:44:39 -0000 *************** f_val_print (struct type *type, const gd *** 366,371 **** --- 366,372 ---- struct type *elttype; LONGEST val; CORE_ADDR addr; + int index; CHECK_TYPEDEF (type); switch (TYPE_CODE (type)) *************** f_val_print (struct type *type, const gd *** 576,581 **** --- 577,596 ---- fprintf_filtered (stream, ""); break; + case TYPE_CODE_STRUCT: + fprintf_filtered (stream, "{ "); + for (index = 0; index < TYPE_NFIELDS (type); index++) + { + gdb_byte *field_addr = valaddr + TYPE_FIELD_BITPOS (type, index) / 8; + f_val_print (TYPE_FIELD_TYPE (type, index), field_addr, + embedded_offset, address, stream, + format, deref_ref, recurse, pretty); + if (index != TYPE_NFIELDS (type) - 1) + fputs_filtered (", ", stream); + } + fprintf_filtered (stream, "}"); + break; + default: error (_("Invalid F77 type code %d in symbol table."), TYPE_CODE (type)); } I also coded a testcase for this. It needs gfortran to build. The command line I used to test this is: make check RUNTESTFLAGS="F77_FOR_TARGET='gfortran' gdb.fortran/derived-type.exp" Tested on Federo Core 4. It reported 3 passes. 2005-10-27 Wu Zhou * gdb.fortran/derived-type.exp: New testcase. * gdb.fortran/derived-type.f90: New file. Index: gdb.fortran/derived-type.exp =================================================================== RCS file: gdb.fortran/derived-type.exp diff -N gdb.fortran/derived-type.exp *** /dev/null 1 Jan 1970 00:00:00 -0000 --- gdb.fortran/derived-type.exp 27 Oct 2005 06:53:33 -0000 *************** *** 0 **** --- 1,54 ---- + # Copyright 2005 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 2 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, write to the Free Software + # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + + # This file was written by Wu Zhou. (woodzltc@cn.ibm.com) + + # This file is part of the gdb testsuite. It contains tests for type-printing + # and value-printing Fortran derived types. + + if $tracelevel then { + strace $tracelevel + } + + set testfile "derived-type" + set srcfile ${testfile}.f90 + set binfile ${objdir}/${subdir}/${testfile} + + if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f77 quiet}] != "" } { + untested "Couldn't compile ${srcfile}" + return -1 + } + + gdb_exit + gdb_start + gdb_reinitialize_dir $srcdir/$subdir + gdb_load ${binfile} + + if ![runto MAIN__] then { + perror "couldn't run to breakpoint MAIN__" + continue + } + + gdb_test "ptype q" \ + "type = Type foo.*real.*a.*character.*7.*b.*int4.*c.*End type.*" \ + "type-printing for derived type" + + gdb_breakpoint [gdb_get_line_number "print"] + gdb_continue_to_breakpoint "print" + + gdb_test "print q" \ + ".*1 = \\{ 3.125,.*\\(.*a.*b.*c.*d.*e.*f.*\\),.*42.*\\}" \ + "value-printing for derived type" Index: gdb.fortran/derived-type.f90 =================================================================== RCS file: gdb.fortran/derived-type.f90 diff -N gdb.fortran/derived-type.f90 *** /dev/null 1 Jan 1970 00:00:00 -0000 --- gdb.fortran/derived-type.f90 27 Oct 2005 06:53:33 -0000 *************** *** 0 **** --- 1,13 ---- + program main + + type foo + real :: a + character*7 :: b + integer :: c + end type foo + type(foo) :: q + + q = foo(3.125, "abcdef", 42) + print *,q + + end program main Regards - Wu Zhou