* dwarf2read.c (dwarf_decode_lines): Call record_line upon

[deliverable/binutils-gdb.git] / gdb / f-valprint.c

diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 69e7da02e98b1f7bc970c490a3d5375b95e4e2dd..b83597cf3b0a8645ab9baedf396db64328fe9e2f 100644 (file)
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -1,7 +1,7 @@
 /* Support for printing Fortran values for GDB, the GNU debugger.
 
-   Copyright 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2003, 2005 Free
-   Software Foundation, Inc.
+   Copyright (C) 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2003, 2005, 2006
+   Free Software Foundation, Inc.
 
    Contributed by Motorola.  Adapted from the C definitions by Farooq Butt
    (fmbutt@engage.sps.mot.com), additionally worked over by Stan Shebs.
@@ -20,8 +20,8 @@
 
    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.  */
+   Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */
 
 #include "defs.h"
 #include "gdb_string.h"
@@ -274,7 +274,7 @@ f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
 
 static void
 f77_print_array_1 (int nss, int ndimensions, struct type *type,
-                  const bfd_byte *valaddr, CORE_ADDR address,
+                  const gdb_byte *valaddr, CORE_ADDR address,
                   struct ui_file *stream, int format,
                   int deref_ref, int recurse, enum val_prettyprint pretty,
                   int *elts)
@@ -319,7 +319,7 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
    stuff and then immediately call f77_print_array_1() */
 
 static void
-f77_print_array (struct type *type, const bfd_byte *valaddr,
+f77_print_array (struct type *type, const gdb_byte *valaddr,
                 CORE_ADDR address, struct ui_file *stream,
                 int format, int deref_ref, int recurse,
                 enum val_prettyprint pretty)
@@ -358,7 +358,7 @@ f77_print_array (struct type *type, const bfd_byte *valaddr,
    The PRETTY parameter controls prettyprinting.  */
 
 int
-f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
+f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
             CORE_ADDR address, struct ui_file *stream, int format,
             int deref_ref, int recurse, enum val_prettyprint pretty)
 {
@@ -366,6 +366,7 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
   struct type *elttype;
   LONGEST val;
   CORE_ADDR addr;
+  int index;
 
   CHECK_TYPEDEF (type);
   switch (TYPE_CODE (type))
@@ -402,7 +403,7 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
            }
 
          if (addressprint && format != 's')
-           print_address_numeric (addr, 1, stream);
+           deprecated_print_address_numeric (addr, 1, stream);
 
          /* For a pointer to char or unsigned char, also print the string
             pointed to, unless pointer is null.  */
@@ -426,7 +427,7 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
          CORE_ADDR addr
            = extract_typed_address (valaddr + embedded_offset, type);
          fprintf_filtered (stream, "@");
-         print_address_numeric (addr, 1, stream);
+         deprecated_print_address_numeric (addr, 1, stream);
          if (deref_ref)
            fputs_filtered (": ", stream);
        }
@@ -440,15 +441,8 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
              (TYPE_TARGET_TYPE (type),
               unpack_pointer (lookup_pointer_type (builtin_type_void),
                               valaddr + embedded_offset));
-             val_print (value_type (deref_val),
-                        value_contents (deref_val),
-                        0,
-                        VALUE_ADDRESS (deref_val),
-                        stream,
-                        format,
-                        deref_ref,
-                        recurse,
-                        pretty);
+             common_val_print (deref_val, stream, format, deref_ref, recurse,
+                               pretty);
            }
          else
            fputs_filtered ("???", stream);
@@ -490,6 +484,13 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
        }
       break;
 
+    case TYPE_CODE_FLAGS:
+      if (format)
+         print_scalar_formatted (valaddr, type, format, 0, stream);
+      else
+       val_print_type_code_flags (type, valaddr, stream);
+      break;
+
     case TYPE_CODE_FLT:
       if (format)
        print_scalar_formatted (valaddr, type, format, 0, stream);
@@ -583,6 +584,22 @@ f_val_print (struct type *type, const bfd_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));
     }
@@ -597,7 +614,7 @@ list_all_visible_commons (char *funname)
 
   tmp = head_common_list;
 
-  printf_filtered ("All COMMON blocks visible at this level:\n\n");
+  printf_filtered (_("All COMMON blocks visible at this level:\n\n"));
 
   while (tmp != NULL)
     {
@@ -683,9 +700,9 @@ info_common_command (char *comname, int from_tty)
   if (the_common)
     {
       if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0)
-       printf_filtered ("Contents of blank COMMON block:\n");
+       printf_filtered (_("Contents of blank COMMON block:\n"));
       else
-       printf_filtered ("Contents of F77 COMMON block '%s':\n", comname);
+       printf_filtered (_("Contents of F77 COMMON block '%s':\n"), comname);
 
       printf_filtered ("\n");
       entry = the_common->entries;
@@ -699,7 +716,7 @@ info_common_command (char *comname, int from_tty)
        }
     }
   else
-    printf_filtered ("Cannot locate the common block %s in function '%s'\n",
+    printf_filtered (_("Cannot locate the common block %s in function '%s'\n"),
                     comname, funname);
 }
 
@@ -771,8 +788,8 @@ void
 _initialize_f_valprint (void)
 {
   add_info ("common", info_common_command,
-           "Print out the values contained in a Fortran COMMON block.");
+           _("Print out the values contained in a Fortran COMMON block."));
   if (xdb_commands)
     add_com ("lc", class_info, info_common_command,
-            "Print out the values contained in a Fortran COMMON block.");
+            _("Print out the values contained in a Fortran COMMON block."));
 }