diff options
| -rw-r--r-- | gdb/ChangeLog | 17 | ||||
| -rw-r--r-- | gdb/f-exp.y | 20 | ||||
| -rw-r--r-- | gdb/f-typeprint.c | 48 | ||||
| -rw-r--r-- | gdb/f-valprint.c | 17 |
4 files changed, 81 insertions, 21 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index f26f680..3c14515 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,20 @@ +2006-02-24 Wu Zhou <woodzltc@cn.ibm.com> + + * 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 <dan@codesourcery.com> * gdb_curses.h: Provide a fallback prototype for tgetnum. diff --git a/gdb/f-exp.y b/gdb/f-exp.y index f20a54f..64ac9be 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 <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, @@ -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 1a4fbf5..b0de0ab 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 <unknown>"); + fprintfi_filtered (level, stream, "struct <unknown>"); break; case TYPE_CODE_ERROR: - fprintf_filtered (stream, "<unknown type>"); + fprintfi_filtered (level, stream, "<unknown type>"); break; case TYPE_CODE_RANGE: /* This should not occur */ - fprintf_filtered (stream, "<range type>"); + fprintfi_filtered (level, stream, "<range type>"); 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 e724f76..b83597c 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, "<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++) + { + 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)); } |