From 2a5e440cb420e37baa7e716febb0d48586e8f44b Mon Sep 17 00:00:00 2001 From: Wu Zhou Date: Fri, 24 Feb 2006 07:26:10 +0000 Subject: [PATCH] * f-exp.y: Symbol '%' is not used as the modulus operator in Fortran. Delete this from Fortran expression. It is now used by Fortran 90 and later 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. --- gdb/ChangeLog | 17 +++++++++++++++++ gdb/f-exp.y | 20 ++++++++++++++------ gdb/f-typeprint.c | 48 ++++++++++++++++++++++++++++++++--------------- gdb/f-valprint.c | 17 +++++++++++++++++ 4 files changed, 81 insertions(+), 21 deletions(-) diff --git a/gdb/ChangeLog b/gdb/ChangeLog index f26f680de4c..3c1451544c7 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,20 @@ +2006-02-24 Wu Zhou + + * f-exp.y: Symbol '%' is not used as the modulus operator in + Fortran. Delete this from Fortran expression. + It is now used by Fortran 90 and later 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. + 2006-02-23 Daniel Jacobowitz * gdb_curses.h: Provide a fallback prototype for tgetnum. diff --git a/gdb/f-exp.y b/gdb/f-exp.y index f20a54f4bf1..64ac9becf25 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -1,6 +1,6 @@ /* YACC parser for Fortran expressions, for GDB. Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1995, 1996, 2000, 2001, - 2002, 2003, 2004, 2005 Free Software Foundation, Inc. + 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. Contributed by Motorola. Adapted from the C parser by Farooq Butt (fmbutt@engage.sps.mot.com). @@ -178,6 +178,7 @@ static int parse_number (char *, int, int, YYSTYPE *); %token BOOLEAN_LITERAL %token NAME %token TYPENAME +%type name %type name_not_typename /* A NAME_OR_INT is a symbol which is not known in the symbol table, @@ -217,8 +218,9 @@ static int parse_number (char *, int, int, YYSTYPE *); %left LSH RSH %left '@' %left '+' '-' -%left '*' '/' '%' +%left '*' '/' %right STARSTAR +%right '%' %right UNARY %right '(' @@ -332,6 +334,12 @@ exp : '(' type ')' exp %prec UNARY 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 @@ -350,10 +358,6 @@ exp : exp '/' exp { write_exp_elt_opcode (BINOP_DIV); } ; -exp : exp '%' exp - { write_exp_elt_opcode (BINOP_REM); } - ; - exp : exp '+' exp { write_exp_elt_opcode (BINOP_ADD); } ; @@ -635,6 +639,10 @@ nonempty_typelist } ; +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 diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index 1a4fbf5b43a..b0de0ab0119 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -1,7 +1,7 @@ /* Support for printing Fortran types for GDB, the GNU debugger. Copyright (C) 1986, 1988, 1989, 1991, 1993, 1994, 1995, 1996, 1998, - 2000, 2001, 2002, 2003 Free Software Foundation, Inc. + 2000, 2001, 2002, 2003, 2006 Free Software Foundation, Inc. Contributed by Motorola. Adapted from the C version by Farooq Butt (fmbutt@engage.sps.mot.com). @@ -41,7 +41,7 @@ static void f_type_print_args (struct type *, struct ui_file *); #endif -static void print_equivalent_f77_float_type (struct type *, +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 *, @@ -260,13 +260,14 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, } static void -print_equivalent_f77_float_type (struct type *type, struct ui_file *stream) +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 */ - fprintf_filtered (stream, "real*%d", TYPE_LENGTH (type)); + fprintfi_filtered (level, stream, "real*%d", TYPE_LENGTH (type)); } /* Print the name of the type (or the ultimate pointer target, @@ -289,6 +290,8 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show, int retcode; int upper_bound; + int index; + QUIT; wrap_here (" "); @@ -304,7 +307,7 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show, if ((show <= 0) && (TYPE_NAME (type) != NULL)) { if (TYPE_CODE (type) == TYPE_CODE_FLT) - print_equivalent_f77_float_type (type, stream); + print_equivalent_f77_float_type (level, type, stream); else fputs_filtered (TYPE_NAME (type), stream); return; @@ -335,25 +338,25 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show, break; case TYPE_CODE_VOID: - fprintf_filtered (stream, "VOID"); + fprintfi_filtered (level, stream, "VOID"); break; case TYPE_CODE_UNDEF: - fprintf_filtered (stream, "struct "); + fprintfi_filtered (level, stream, "struct "); break; case TYPE_CODE_ERROR: - fprintf_filtered (stream, ""); + fprintfi_filtered (level, stream, ""); break; case TYPE_CODE_RANGE: /* This should not occur */ - fprintf_filtered (stream, ""); + fprintfi_filtered (level, stream, ""); break; case TYPE_CODE_CHAR: /* Override name "char" and make it "character" */ - fprintf_filtered (stream, "character"); + fprintfi_filtered (level, stream, "character"); break; case TYPE_CODE_INT: @@ -362,24 +365,24 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show, C-oriented, we must change these to "character" from "char". */ if (strcmp (TYPE_NAME (type), "char") == 0) - fprintf_filtered (stream, "character"); + fprintfi_filtered (level, stream, "character"); else goto default_case; break; case TYPE_CODE_COMPLEX: - fprintf_filtered (stream, "complex*%d", TYPE_LENGTH (type)); + fprintfi_filtered (level, stream, "complex*%d", TYPE_LENGTH (type)); break; case TYPE_CODE_FLT: - print_equivalent_f77_float_type (type, stream); + 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) - fprintf_filtered (stream, "character*(*)"); + fprintfi_filtered (level, stream, "character*(*)"); else { retcode = f77_get_dynamic_upperbound (type, &upper_bound); @@ -391,6 +394,21 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show, } 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, @@ -398,7 +416,7 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show, 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); + fprintfi_filtered (level, stream, "%s ", TYPE_NAME (type)); else error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type)); break; diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c index e724f7665bc..b83597cf3b0 100644 --- a/gdb/f-valprint.c +++ b/gdb/f-valprint.c @@ -366,6 +366,7 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset, struct type *elttype; LONGEST val; CORE_ADDR addr; + int index; CHECK_TYPEDEF (type); switch (TYPE_CODE (type)) @@ -583,6 +584,22 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset, fprintf_filtered (stream, ""); 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++) + { + int offset = TYPE_FIELD_BITPOS (type, index) / 8; + f_val_print (TYPE_FIELD_TYPE (type, index), valaddr + offset, + 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)); } -- 2.30.2