summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gdb/ChangeLog17
-rw-r--r--gdb/f-exp.y20
-rw-r--r--gdb/f-typeprint.c48
-rw-r--r--gdb/f-valprint.c17
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 <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 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 <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 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 <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 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, "<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));
}