[RFC]: Patch to type and value print Fortran derived type - Fix forgfortran PR24527

[Wu Zhou <woodzltc at CN dot IBM dot COM>]

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  <woodzltc@cn.ibm.com>

	* 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, "<incomplete type>");
        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  <woodzltc@cn.ibm.com>

	* 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