This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
Re: [RFC]: Patch to support Fortran derived type - Revised
- From: Wu Zhou <woodzltc at cn dot ibm dot com>
- To: Daniel Jacobowitz <drow at false dot org>
- Cc: gdb-patches at sources dot redhat dot com, Thomas dot Koenig at online dot de
- Date: Sat, 10 Dec 2005 15:24:29 +0800 (CST)
- Subject: Re: [RFC]: Patch to support Fortran derived type - Revised
- References: <Pine.LNX.4.63.0511161454200.21051@linux.site> <20051207232541.GB7483@nevyn.them.org>
Hi, Daniel/Eli
Thanks a lot for your kind comments. My replies is as follows.
On Wed, 7 Dec 2005, Daniel Jacobowitz wrote:
> Hi Wu, sorry about the delay. Just a couple of small comments. First
> of all, I'd prefer not to approve this without documentation and a
> testcase.
No problem. I know your guys are really busy. :-)
I had submitted a testcase and a little document in other mails. I will
now include them in one mail this time, with a little more document about
the type and value print.
> > 2005-11-16 Wu Zhou <woodzltc@cn.ibm.com>
> >
> > * f-exp.y: Symbol '%' is not used as modular operator in Fortran.
> > Delete this from Fortran expression.
> > It is now used by Fortran 95 to access the member of derived type.
> > Add this into Fortran expression.
>
> You want "is not used as the modulus operator" here, I believe. There's
> a "modular operator" also, which seems to be something complicated in
> operator theory - completely different.
OK. Thanks for pointing this out.
> > +name : NAME
> > + { $$ = $1.stoken; }
> > + ;
> > +
>
> Why not just use name_not_typename instead of adding "name"?
>
> Also, the comments in name_not_typename don't apply here; you could
> also handle exp : exp % NAME_OR_INT as a name. But, I don't think that
> adds much value. The whole NAME_OR_INT thing seems like overkill.
AFAICT, adding "name" might be a more direct and easier way to handle
that. I am not sure yet how to handle name_not_typename or NAME_OR_INT,
but it seems that some more work is needed in either the parsing or
evaluation phase. What is more, using "name" is the same way as that in
c and c++ expression parser, which looks to be more consistent.
Does these make sense?
> > + /* Starting from Fortran 90 standard, Fortran language began to support
> > + derived type. The type code is TYPE_CODE_STRUCT. */
>
> /* Starting from the Fortran 90 standard, Fortran supports derived
> types. */
>
> Two periods after period, please :-) I think you can skip mentioning
> TYPE_CODE_STRUCT, since it's the case label.
Thanks. Your words is much more concise than mine.
> > +print_equivalent_f77_float_type (int level, struct type *type, struct ui_file *stream)
>
> Needs to be wrapped.
Yes. It needs wrapping.
> The rest looks fine.
Here is the revised patch, testcase and documents.
2005-12-10 Wu Zhou <woodzltc@cn.ibm.com>
* f-exp.y: Symbol '%' is not used as the modular operator in
Fortran. Delete this from Fortran expression.
It is now used by Fortran 90 and afterwards to access the member
of derived type. Add this into Fortran expression.
* f-valprint.c (f_val_print): Add code to handle TYPE_CODE_STRUCT.
Print each elements in the derived type.
* f-typeprint.c (print_equivalent_f77_float_type): Add a parameter
level into the function definition to do indented printing. And
call fprintfi_filtered instead to do indented printing.
(f_type_print_base): Replace fprintf_filtered with the indented
version (fprintfi_filtered).
(f_type_print_base): Call indented print_equivalent_f77_float_type.
(f_type_print_base): Add code to handle TYPE_CODE_STRUCT. Print
the definition of the derived type.
Index: f-exp.y
===================================================================
RCS file: /cvs/src/src/gdb/f-exp.y,v
retrieving revision 1.18
diff -c -p -r1.18 f-exp.y
*** f-exp.y 20 Sep 2005 06:25:34 -0000 1.18
--- f-exp.y 10 Dec 2005 06:50:50 -0000
*************** static int parse_number (char *, int, in
*** 177,182 ****
--- 177,183 ----
%token <lval> BOOLEAN_LITERAL
%token <ssym> NAME
%token <tsym> TYPENAME
+ %type <sval> name
%type <ssym> name_not_typename
/* A NAME_OR_INT is a symbol which is not known in the symbol table,
*************** static int parse_number (char *, int, in
*** 216,223 ****
%left LSH RSH
%left '@'
%left '+' '-'
! %left '*' '/' '%'
%right STARSTAR
%right UNARY
%right '('
--- 217,225 ----
%left LSH RSH
%left '@'
%left '+' '-'
! %left '*' '/'
%right STARSTAR
+ %right '%'
%right UNARY
%right '('
*************** exp : '(' type ')' exp %prec UNARY
*** 331,336 ****
--- 333,344 ----
write_exp_elt_opcode (UNOP_CAST); }
;
+ exp : exp '%' name
+ { write_exp_elt_opcode (STRUCTOP_STRUCT);
+ write_exp_string ($3);
+ write_exp_elt_opcode (STRUCTOP_STRUCT); }
+ ;
+
/* Binary operators in order of decreasing precedence. */
exp : exp '@' exp
*************** exp : exp '/' exp
*** 349,358 ****
{ write_exp_elt_opcode (BINOP_DIV); }
;
- exp : exp '%' exp
- { write_exp_elt_opcode (BINOP_REM); }
- ;
-
exp : exp '+' exp
{ write_exp_elt_opcode (BINOP_ADD); }
;
--- 357,362 ----
*************** nonempty_typelist
*** 634,639 ****
--- 638,647 ----
}
;
+ name : NAME
+ { $$ = $1.stoken; }
+ ;
+
name_not_typename : NAME
/* These would be useful if name_not_typename was useful, but it is just
a fake for "variable", so these cause reduce/reduce conflicts because
Index: f-valprint.c
===================================================================
RCS file: /cvs/src/src/gdb/f-valprint.c,v
retrieving revision 1.30
diff -c -p -r1.30 f-valprint.c
*** f-valprint.c 9 May 2005 21:20:30 -0000 1.30
--- f-valprint.c 10 Dec 2005 06:50:50 -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,598 ----
fprintf_filtered (stream, "<incomplete type>");
break;
+ case TYPE_CODE_STRUCT:
+ /* Starting from the Fortran 90 standard, Fortran supports derived
+ types. */
+ fprintf_filtered (stream, "{ ");
+ for (index = 0; index < TYPE_NFIELDS (type); index++)
+ {
+ char * 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));
}
Index: f-typeprint.c
===================================================================
RCS file: /cvs/src/src/gdb/f-typeprint.c,v
retrieving revision 1.13
diff -c -p -r1.13 f-typeprint.c
*** f-typeprint.c 11 Feb 2005 04:05:47 -0000 1.13
--- f-typeprint.c 10 Dec 2005 06:50:50 -0000
***************
*** 1,7 ****
/* Support for printing Fortran types for GDB, the GNU debugger.
Copyright 1986, 1988, 1989, 1991, 1993, 1994, 1995, 1996, 1998,
! 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
Contributed by Motorola. Adapted from the C version by Farooq Butt
(fmbutt@engage.sps.mot.com).
--- 1,7 ----
/* Support for printing Fortran types for GDB, the GNU debugger.
Copyright 1986, 1988, 1989, 1991, 1993, 1994, 1995, 1996, 1998,
! 2000, 2001, 2002, 2003, 2005 Free Software Foundation, Inc.
Contributed by Motorola. Adapted from the C version by Farooq Butt
(fmbutt@engage.sps.mot.com).
***************
*** 41,47 ****
static void f_type_print_args (struct type *, struct ui_file *);
#endif
! static void print_equivalent_f77_float_type (struct type *,
struct ui_file *);
static void f_type_print_varspec_suffix (struct type *, struct ui_file *,
--- 41,47 ----
static void f_type_print_args (struct type *, struct ui_file *);
#endif
! static void print_equivalent_f77_float_type (int level, struct type *,
struct ui_file *);
static void f_type_print_varspec_suffix (struct type *, struct ui_file *,
*************** f_type_print_varspec_suffix (struct type
*** 260,272 ****
}
static void
! print_equivalent_f77_float_type (struct type *type, struct ui_file *stream)
{
/* Override type name "float" and make it the
appropriate real. XLC stupidly outputs -12 as a type
for real when it really should be outputting -18 */
! fprintf_filtered (stream, "real*%d", TYPE_LENGTH (type));
}
/* Print the name of the type (or the ultimate pointer target,
--- 260,273 ----
}
static void
! print_equivalent_f77_float_type (int level, struct type *type,
! struct ui_file *stream)
{
/* Override type name "float" and make it the
appropriate real. XLC stupidly outputs -12 as a type
for real when it really should be outputting -18 */
! fprintfi_filtered (level, stream, "real*%d", TYPE_LENGTH (type));
}
/* Print the name of the type (or the ultimate pointer target,
*************** f_type_print_base (struct type *type, st
*** 289,294 ****
--- 290,297 ----
int retcode;
int upper_bound;
+ int index;
+
QUIT;
wrap_here (" ");
*************** f_type_print_base (struct type *type, st
*** 304,310 ****
if ((show <= 0) && (TYPE_NAME (type) != NULL))
{
if (TYPE_CODE (type) == TYPE_CODE_FLT)
! print_equivalent_f77_float_type (type, stream);
else
fputs_filtered (TYPE_NAME (type), stream);
return;
--- 307,313 ----
if ((show <= 0) && (TYPE_NAME (type) != NULL))
{
if (TYPE_CODE (type) == TYPE_CODE_FLT)
! print_equivalent_f77_float_type (level, type, stream);
else
fputs_filtered (TYPE_NAME (type), stream);
return;
*************** f_type_print_base (struct type *type, st
*** 335,359 ****
break;
case TYPE_CODE_VOID:
! fprintf_filtered (stream, "VOID");
break;
case TYPE_CODE_UNDEF:
! fprintf_filtered (stream, "struct <unknown>");
break;
case TYPE_CODE_ERROR:
! fprintf_filtered (stream, "<unknown type>");
break;
case TYPE_CODE_RANGE:
/* This should not occur */
! fprintf_filtered (stream, "<range type>");
break;
case TYPE_CODE_CHAR:
/* Override name "char" and make it "character" */
! fprintf_filtered (stream, "character");
break;
case TYPE_CODE_INT:
--- 338,362 ----
break;
case TYPE_CODE_VOID:
! fprintfi_filtered (level, stream, "VOID");
break;
case TYPE_CODE_UNDEF:
! fprintfi_filtered (level, stream, "struct <unknown>");
break;
case TYPE_CODE_ERROR:
! fprintfi_filtered (level, stream, "<unknown type>");
break;
case TYPE_CODE_RANGE:
/* This should not occur */
! fprintfi_filtered (level, stream, "<range type>");
break;
case TYPE_CODE_CHAR:
/* Override name "char" and make it "character" */
! fprintfi_filtered (level, stream, "character");
break;
case TYPE_CODE_INT:
*************** f_type_print_base (struct type *type, st
*** 362,385 ****
C-oriented, we must change these to "character" from "char". */
if (strcmp (TYPE_NAME (type), "char") == 0)
! fprintf_filtered (stream, "character");
else
goto default_case;
break;
case TYPE_CODE_COMPLEX:
! fprintf_filtered (stream, "complex*%d", TYPE_LENGTH (type));
break;
case TYPE_CODE_FLT:
! print_equivalent_f77_float_type (type, stream);
break;
case TYPE_CODE_STRING:
/* Strings may have dynamic upperbounds (lengths) like arrays. */
if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
! fprintf_filtered (stream, "character*(*)");
else
{
retcode = f77_get_dynamic_upperbound (type, &upper_bound);
--- 365,388 ----
C-oriented, we must change these to "character" from "char". */
if (strcmp (TYPE_NAME (type), "char") == 0)
! fprintfi_filtered (level, stream, "character");
else
goto default_case;
break;
case TYPE_CODE_COMPLEX:
! fprintfi_filtered (level, stream, "complex*%d", TYPE_LENGTH (type));
break;
case TYPE_CODE_FLT:
! print_equivalent_f77_float_type (level, type, stream);
break;
case TYPE_CODE_STRING:
/* Strings may have dynamic upperbounds (lengths) like arrays. */
if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
! fprintfi_filtered (level, stream, "character*(*)");
else
{
retcode = f77_get_dynamic_upperbound (type, &upper_bound);
*************** f_type_print_base (struct type *type, st
*** 391,396 ****
--- 394,414 ----
}
break;
+ case TYPE_CODE_STRUCT:
+ fprintfi_filtered (level, stream, "Type ");
+ fputs_filtered (TYPE_TAG_NAME (type), stream);
+ fputs_filtered ("\n", stream);
+ for (index = 0; index < TYPE_NFIELDS (type); index++)
+ {
+ f_print_type (TYPE_FIELD_TYPE (type, index), "", stream, show, level + 4);
+ fputs_filtered (" :: ", stream);
+ fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
+ fputs_filtered ("\n", stream);
+ }
+ fprintfi_filtered (level, stream, "End Type ");
+ fputs_filtered (TYPE_TAG_NAME (type), stream);
+ break;
+
default_case:
default:
/* Handle types not explicitly handled by the other cases,
*************** f_type_print_base (struct type *type, st
*** 398,404 ****
the type name is, as recorded in the type itself. If there
is no type name, then complain. */
if (TYPE_NAME (type) != NULL)
! fputs_filtered (TYPE_NAME (type), stream);
else
error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
break;
--- 416,422 ----
the type name is, as recorded in the type itself. If there
is no type name, then complain. */
if (TYPE_NAME (type) != NULL)
! fprintfi_filtered (level, stream, "%s ", TYPE_NAME (type));
else
error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
break;
2005-12-10 Wu Zhou <woodzltc@cn.ibm.com>
* gdb.fortran/derived-type.f90: New file.
* .fortran/derived-type.exp: New testcase.
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 16 Nov 2005 06:50:22 -0000
@@ -0,0 +1,22 @@
+program main
+
+ type bar
+ integer :: c
+ real :: d
+ end type
+ type foo
+ real :: a
+ type(bar) :: x
+ character*7 :: b
+ end type foo
+ type(foo) :: q
+ type(bar) :: p
+
+ p = bar(1, 2.375)
+ q%a = 3.125
+ q%b = "abcdefg"
+ q%x%c = 1
+ q%x%d = 2.375
+ print *,p,q
+
+end program main
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 16 Nov 2005 06:50:22 -0000
@@ -0,0 +1,65 @@
+# 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 p" \
+ "type = Type bar.*int4.*\:\: c.*real.*\:\: d.*End Type bar" \
+ "ptype p"
+gdb_test "ptype q" \
+ "type = Type foo.*real.*\:\: a.*Type bar.*int4.*\:\: c.*real.*\:\: d.*End Type bar \:\: x.*character.*\\(7\\) \:\: b.*End Type foo" \
+ "type-printing for derived type"
+
+gdb_breakpoint [gdb_get_line_number "print"]
+gdb_continue_to_breakpoint "print"
+
+gdb_test "print p" "\\$\[0-9\]+ = \\{ 1, 2.375\\}"
+gdb_test "print p%c" "\\$\[0-9\]+ = 1"
+gdb_test "print p%d" "\\$\[0-9\]+ = 2.375"
+gdb_test "print q%a" "\\$\[0-9\]+ = 3.125"
+gdb_test "print q%b" "\\$\[0-9\]+ = \\(.*a.*b.*c.*d.*e.*f.*g.*\\)"
+gdb_test "print q%x%c" "\\$\[0-9\]+ = 1"
+gdb_test "print q%x%d" "\\$\[0-9\]+ = 2.375"
+gdb_test "print q" \
+ "\\$\[0-9\]+ = \\{ 3.125, \\{ 1, 2.375\\}, \\(.*a.*b.*c.*d.*e.*f.*g.*\\)\\}" \
+ "print q"
+
2005-12-10 Wu Zhou <woodzltc@cn.ibm.com>
* gdb.texinfo (Fortran): Document the "%" operator for member
access.
(Fortran): Document the type-print and value-print operation of
Fortran 90 derived types.
Index: gdb.texinfo
===================================================================
RCS file: /cvs/src/src/gdb/doc/gdb.texinfo,v
retrieving revision 1.282.2.4
diff -c -p -r1.282.2.4 gdb.texinfo
*** gdb.texinfo 23 Nov 2005 02:35:06 -0000 1.282.2.4
--- gdb.texinfo 10 Dec 2005 06:49:36 -0000
*************** of the second one.
*** 9157,9162 ****
--- 9157,9166 ----
@item :
The range operator. Normally used in the form of array(low:high) to
represent a section of array.
+
+ @item %
+ ortran 90 and afterwards use this to access the members of derived
+ type, which is also introduced after the Fortran 90.
@end table
@node Fortran Defaults
*************** This command prints the values contained
*** 9185,9190 ****
--- 9189,9263 ----
block whose name is @var{common-name}. With no argument, the names of
all @code{COMMON} blocks visible at current program location are
printed.
+
+ @cindex Structure type-print
+ @item ptype @var{derived-type}
+ Fortran 90 and afterwards support derived type (a.k.a structure). For
+ a variable of derived type, ptype command will output all its members,
+ including nested derived type.
+
+ For example, for this derived type declaration:
+
+ @smallexample
+ type bar
+ integer :: c
+ real :: d
+ end type
+
+ type foo
+ real :: a
+ type(bar) :: x
+ character*7 :: b
+ end type foo
+ @end smallexample
+
+ @noindent
+ ptype commands give this output:
+
+ @smallexample
+ @group
+ (@value{GDBP}) ptype bar
+ type = Type bar
+ int4 :: c
+ real*4 :: d
+ End Type bar
+ (@value{GDBP}) ptype foo
+ type = Type foo
+ real*4 :: a
+ Type bar
+ int4 :: c
+ real*4 :: d
+ End Type bar :: x
+ character (7) :: b
+ End Type foo
+ @end group
+ @end smallexample
+
+ @noindent
+
+ @cindex Structure value-print
+ @item print @var{derived-type}
+ For a variable of derived type, print command will output the value of
+ all its members, including its nested derived type .
+
+ For example, for variable q of type foo defined above:
+
+ @smallexample
+ type(foo) :: q
+ @end smallexample
+
+ @noindent
+ print command will output this:
+
+ @smallexample
+ @group
+ (@value{GDBP}) print q
+ $1 = @{ 3.125, @{ 1, 2.375@}, (97 'a', 98 'b', 99 'c', 100 'd', 101 'e', 102 'f', 103 'g')@}
+ @end group
+ @end smallexample
+
+ @noindent
+
@end table
@node Pascal
Regards
- Wu Zhou