gdb-fortran-common.patch

   1 Index: gdb-7.4.91.20120801/gdb/dwarf2read.c
   2 ===================================================================
   3 --- gdb-7.4.91.20120801.orig/gdb/dwarf2read.c   2012-08-01 18:36:51.000000000 +0200
   4 +++ gdb-7.4.91.20120801/gdb/dwarf2read.c        2012-08-01 18:38:54.201540500 +0200
   5 @@ -11073,12 +11073,14 @@ read_set_type (struct die_info *die, str
   6    return set_die_type (die, set_type, cu);
   7  }
   8
   9 -/* First cut: install each common block member as a global variable.  */
  10 +/* Create appropriate locally-scoped variables for all the DW_TAG_common_block
  11 +   entries.  Create also TYPE_CODE_STRUCT listing all such variables to be
  12 +   available for `info common'.  COMMON_BLOCK_DOMAIN is used to sepate the
  13 +   common blocks name namespace from regular variable names.  */
  14
  15  static void
  16  read_common_block (struct die_info *die, struct dwarf2_cu *cu)
  17  {
  18 -  struct die_info *child_die;
  19    struct attribute *attr;
  20    struct symbol *sym;
  21    CORE_ADDR base = (CORE_ADDR) 0;
  22 @@ -11103,20 +11105,67 @@ read_common_block (struct die_info *die,
  23      }
  24    if (die->child != NULL)
  25      {
  26 +      struct objfile *objfile = cu->objfile;
  27 +      struct die_info *child_die;
  28 +      struct type *type;
  29 +      struct field *field;
  30 +      char *name;
  31 +      struct symbol *sym;
  32 +
  33 +      type = alloc_type (objfile);
  34 +      TYPE_CODE (type) = TYPE_CODE_STRUCT;
  35 +      /* Artificial type to be used only by `info common'.  */
  36 +      TYPE_NAME (type) = "<common>";
  37 +
  38 +      child_die = die->child;
  39 +      while (child_die && child_die->tag)
  40 +       {
  41 +         TYPE_NFIELDS (type)++;
  42 +         child_die = sibling_die (child_die);
  43 +       }
  44 +
  45 +      TYPE_FIELDS (type) = obstack_alloc (&objfile->objfile_obstack,
  46 +                                         sizeof (*TYPE_FIELDS (type))
  47 +                                         * TYPE_NFIELDS (type));
  48 +      memset (TYPE_FIELDS (type), 0, sizeof (*TYPE_FIELDS (type))
  49 +                                    * TYPE_NFIELDS (type));
  50 +
  51 +      field = TYPE_FIELDS (type);
  52        child_die = die->child;
  53        while (child_die && child_die->tag)
  54         {
  55           LONGEST offset;
  56
  57 +         /* Create the symbol in the DW_TAG_common_block block in the current
  58 +            symbol scope.  */
  59           sym = new_symbol (child_die, NULL, cu);
  60 +
  61 +         /* Undocumented in DWARF3, when it can be present?  */
  62           if (sym != NULL
  63               && handle_data_member_location (child_die, cu, &offset))
  64             {
  65               SYMBOL_VALUE_ADDRESS (sym) = base + offset;
  66               add_symbol_to_list (sym, &global_symbols);
  67             }
  68 +
  69 +         if (SYMBOL_CLASS (sym) == LOC_STATIC)
  70 +           SET_FIELD_PHYSADDR (*field, SYMBOL_VALUE_ADDRESS (sym));
  71 +         else
  72 +           SET_FIELD_PHYSNAME (*field, SYMBOL_LINKAGE_NAME (sym));
  73 +         FIELD_TYPE (*field) = SYMBOL_TYPE (sym);
  74 +         FIELD_NAME (*field) = SYMBOL_NATURAL_NAME (sym);
  75 +         field++;
  76           child_die = sibling_die (child_die);
  77         }
  78 +
  79 +      /* TYPE_LENGTH (type) is left 0 - it is only a virtual structure even
  80 +        with no consecutive address space.  */
  81 +
  82 +      sym = new_symbol (die, type, cu);
  83 +      /* SYMBOL_VALUE_ADDRESS never gets used as all its fields are static.  */
  84 +      SYMBOL_VALUE_ADDRESS (sym) = base;
  85 +
  86 +      set_die_type (die, type, cu);
  87      }
  88  }
  89
  90 @@ -15155,6 +15204,13 @@ new_symbol_full (struct die_info *die, s
  91             {
  92               var_decode_location (attr, sym, cu);
  93               attr2 = dwarf2_attr (die, DW_AT_external, cu);
  94 +
  95 +             /* Fortran explicitly imports any global symbols to the local
  96 +                scope by DW_TAG_common_block.  */
  97 +             if (cu->language == language_fortran && die->parent
  98 +                 && die->parent->tag == DW_TAG_common_block)
  99 +               attr2 = NULL;
 100 +
 101               if (SYMBOL_CLASS (sym) == LOC_STATIC
 102                   && SYMBOL_VALUE_ADDRESS (sym) == 0
 103                   && !dwarf2_per_objfile->has_section_at_zero)
 104 @@ -15319,6 +15375,11 @@ new_symbol_full (struct die_info *die, s
 105           SYMBOL_CLASS (sym) = LOC_TYPEDEF;
 106           list_to_add = &global_symbols;
 107           break;
 108 +       case DW_TAG_common_block:
 109 +         SYMBOL_CLASS (sym) = LOC_STATIC;
 110 +         SYMBOL_DOMAIN (sym) = COMMON_BLOCK_DOMAIN;
 111 +         add_symbol_to_list (sym, cu->list_in_scope);
 112 +         break;
 113         default:
 114           /* Not a tag we recognize.  Hopefully we aren't processing
 115              trash data, but since we must specifically ignore things
 116 Index: gdb-7.4.91.20120801/gdb/f-lang.c
 117 ===================================================================
 118 --- gdb-7.4.91.20120801.orig/gdb/f-lang.c       2012-08-01 18:38:24.000000000 +0200
 119 +++ gdb-7.4.91.20120801/gdb/f-lang.c    2012-08-01 18:38:54.202540495 +0200
 120 @@ -370,27 +370,3 @@ _initialize_f_language (void)
 121
 122    add_language (&f_language_defn);
 123  }
 124 -
 125 -SAVED_F77_COMMON_PTR head_common_list = NULL;  /* Ptr to 1st saved COMMON  */
 126 -
 127 -/* This routine finds the first encountred COMMON block named "name"
 128 -   that belongs to function funcname.  */
 129 -
 130 -SAVED_F77_COMMON_PTR
 131 -find_common_for_function (const char *name, const char *funcname)
 132 -{
 133 -
 134 -  SAVED_F77_COMMON_PTR tmp;
 135 -
 136 -  tmp = head_common_list;
 137 -
 138 -  while (tmp != NULL)
 139 -    {
 140 -      if (strcmp (tmp->name, name) == 0
 141 -         && strcmp (tmp->owning_function, funcname) == 0)
 142 -       return (tmp);
 143 -      else
 144 -       tmp = tmp->next;
 145 -    }
 146 -  return (NULL);
 147 -}
 148 Index: gdb-7.4.91.20120801/gdb/f-lang.h
 149 ===================================================================
 150 --- gdb-7.4.91.20120801.orig/gdb/f-lang.h       2012-08-01 18:38:24.000000000 +0200
 151 +++ gdb-7.4.91.20120801/gdb/f-lang.h    2012-08-01 18:38:54.203540489 +0200
 152 @@ -52,37 +52,8 @@ enum f90_range_type
 153      NONE_BOUND_DEFAULT         /* "(low:high)"  */
 154    };
 155
 156 -struct common_entry
 157 -  {
 158 -    struct symbol *symbol;     /* The symbol node corresponding
 159 -                                  to this component */
 160 -    struct common_entry *next; /* The next component */
 161 -  };
 162 -
 163 -struct saved_f77_common
 164 -  {
 165 -    char *name;                        /* Name of COMMON */
 166 -    char *owning_function;     /* Name of parent function */
 167 -    int secnum;                        /* Section # of .bss */
 168 -    CORE_ADDR offset;          /* Offset from .bss for
 169 -                                  this block */
 170 -    struct common_entry *entries;      /* List of block's components */
 171 -    struct common_entry *end_of_entries;       /* ptr. to end of components */
 172 -    struct saved_f77_common *next;     /* Next saved COMMON block */
 173 -  };
 174 -
 175 -typedef struct saved_f77_common SAVED_F77_COMMON, *SAVED_F77_COMMON_PTR;
 176 -
 177 -typedef struct common_entry COMMON_ENTRY, *COMMON_ENTRY_PTR;
 178 -
 179 -extern SAVED_F77_COMMON_PTR head_common_list;  /* Ptr to 1st saved COMMON  */
 180 -
 181 -extern SAVED_F77_COMMON_PTR find_common_for_function (const char *,
 182 -                                                     const char *);
 183 -
 184  #define BLANK_COMMON_NAME_ORIGINAL "#BLNK_COM" /* XLF assigned  */
 185  #define BLANK_COMMON_NAME_MF77     "__BLNK__"  /* MF77 assigned  */
 186 -#define BLANK_COMMON_NAME_LOCAL    "__BLANK"   /* Local GDB */
 187
 188  /* When reasonable array bounds cannot be fetched, such as when
 189     you ask to 'mt print symbols' and there is no stack frame and
 190 Index: gdb-7.4.91.20120801/gdb/f-valprint.c
 191 ===================================================================
 192 --- gdb-7.4.91.20120801.orig/gdb/f-valprint.c   2012-08-01 18:38:24.000000000 +0200
 193 +++ gdb-7.4.91.20120801/gdb/f-valprint.c        2012-08-01 18:41:26.411698186 +0200
 194 @@ -34,10 +34,11 @@
 195  #include "gdbcore.h"
 196  #include "command.h"
 197  #include "block.h"
 198 +#include "dictionary.h"
 199 +#include "gdb_assert.h"
 200
 201  extern void _initialize_f_valprint (void);
 202  static void info_common_command (char *, int);
 203 -static void list_all_visible_commons (const char *);
 204  static void f77_create_arrayprint_offset_tbl (struct type *,
 205                                               struct ui_file *);
 206  static void f77_get_dynamic_length_of_aggregate (struct type *);
 207 @@ -420,22 +421,53 @@ f_val_print (struct type *type, const gd
 208    gdb_flush (stream);
 209  }
 210
 211 -static void
 212 -list_all_visible_commons (const char *funname)
 213 +static int
 214 +info_common_command_for_block (struct block *block, const char *comname)
 215  {
 216 -  SAVED_F77_COMMON_PTR tmp;
 217 -
 218 -  tmp = head_common_list;
 219 +  struct block_iterator iter;
 220 +  struct symbol *sym;
 221 +  int values_printed = 0;
 222 +  const char *name;
 223 +  struct value_print_options opts;
 224 +
 225 +  get_user_print_options (&opts);
 226 +
 227 +  ALL_BLOCK_SYMBOLS (block, iter, sym)
 228 +    if (SYMBOL_DOMAIN (sym) == COMMON_BLOCK_DOMAIN)
 229 +      {
 230 +       struct type *type = SYMBOL_TYPE (sym);
 231 +       int index;
 232 +
 233 +       gdb_assert (SYMBOL_CLASS (sym) == LOC_STATIC);
 234 +       gdb_assert (TYPE_CODE (type) == TYPE_CODE_STRUCT);
 235 +
 236 +       if (comname && (!SYMBOL_LINKAGE_NAME (sym)
 237 +                       || strcmp (comname, SYMBOL_LINKAGE_NAME (sym)) != 0))
 238 +         continue;
 239 +
 240 +       values_printed = 1;
 241 +       if (SYMBOL_PRINT_NAME (sym))
 242 +         printf_filtered (_("Contents of F77 COMMON block '%s':\n"),
 243 +                          SYMBOL_PRINT_NAME (sym));
 244 +       else
 245 +         printf_filtered (_("Contents of blank COMMON block:\n"));
 246 +
 247 +       for (index = 0; index < TYPE_NFIELDS (type); index++)
 248 +         {
 249 +           struct value *val;
 250 +
 251 +           gdb_assert (field_is_static (&TYPE_FIELD (type, index)));
 252 +           val = value_static_field (type, index);
 253 +
 254 +           printf_filtered ("%s = ", TYPE_FIELD_NAME (type, index));
 255 +           value_print (val, gdb_stdout, &opts);
 256 +           putchar_filtered ('\n');
 257 +         }
 258
 259 -  printf_filtered (_("All COMMON blocks visible at this level:\n\n"));
 260 -
 261 -  while (tmp != NULL)
 262 -    {
 263 -      if (strcmp (tmp->owning_function, funname) == 0)
 264 -       printf_filtered ("%s\n", tmp->name);
 265 +       putchar_filtered ('\n');
 266 +      }
 267
 268 -      tmp = tmp->next;
 269 -    }
 270 +  return values_printed;
 271  }
 272
 273  /* This function is used to print out the values in a given COMMON
 274 @@ -445,11 +477,9 @@ list_all_visible_commons (const char *fu
 275  static void
 276  info_common_command (char *comname, int from_tty)
 277  {
 278 -  SAVED_F77_COMMON_PTR the_common;
 279 -  COMMON_ENTRY_PTR entry;
 280    struct frame_info *fi;
 281 -  const char *funname = 0;
 282 -  struct symbol *func;
 283 +  struct block *block;
 284 +  int values_printed = 0;
 285
 286    /* We have been told to display the contents of F77 COMMON
 287       block supposedly visible in this function.  Let us
 288 @@ -461,87 +491,31 @@ info_common_command (char *comname, int
 289    /* The following is generally ripped off from stack.c's routine
 290       print_frame_info().  */
 291
 292 -  func = find_pc_function (get_frame_pc (fi));
 293 -  if (func)
 294 +  block = get_frame_block (fi, 0);
 295 +  if (block == NULL)
 296      {
 297 -      /* In certain pathological cases, the symtabs give the wrong
 298 -         function (when we are in the first function in a file which
 299 -         is compiled without debugging symbols, the previous function
 300 -         is compiled with debugging symbols, and the "foo.o" symbol
 301 -         that is supposed to tell us where the file with debugging symbols
 302 -         ends has been truncated by ar because it is longer than 15
 303 -         characters).
 304 -
 305 -         So look in the minimal symbol tables as well, and if it comes
 306 -         up with a larger address for the function use that instead.
 307 -         I don't think this can ever cause any problems; there shouldn't
 308 -         be any minimal symbols in the middle of a function.
 309 -         FIXME:  (Not necessarily true.  What about text labels?)  */
 310 -
 311 -      struct minimal_symbol *msymbol =
 312 -       lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 313 -
 314 -      if (msymbol != NULL
 315 -         && (SYMBOL_VALUE_ADDRESS (msymbol)
 316 -             > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
 317 -       funname = SYMBOL_LINKAGE_NAME (msymbol);
 318 -      else
 319 -       funname = SYMBOL_LINKAGE_NAME (func);
 320 -    }
 321 -  else
 322 -    {
 323 -      struct minimal_symbol *msymbol =
 324 -       lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 325 -
 326 -      if (msymbol != NULL)
 327 -       funname = SYMBOL_LINKAGE_NAME (msymbol);
 328 -      else /* Got no 'funname', code below will fail.  */
 329 -       error (_("No function found for frame."));
 330 +      printf_filtered (_("No symbol table info available.\n"));
 331 +      return;
 332      }
 333
 334 -  /* If comname is NULL, we assume the user wishes to see the
 335 -     which COMMON blocks are visible here and then return.  */
 336 -
 337 -  if (comname == 0)
 338 +  while (block)
 339      {
 340 -      list_all_visible_commons (funname);
 341 -      return;
 342 +      if (info_common_command_for_block (block, comname))
 343 +       values_printed = 1;
 344 +      /* After handling the function's top-level block, stop.  Don't
 345 +         continue to its superblock, the block of per-file symbols.  */
 346 +      if (BLOCK_FUNCTION (block))
 347 +       break;
 348 +      block = BLOCK_SUPERBLOCK (block);
 349      }
 350
 351 -  the_common = find_common_for_function (comname, funname);
 352 -
 353 -  if (the_common)
 354 +  if (!values_printed)
 355      {
 356 -      struct frame_id frame_id = get_frame_id (fi);
 357 -
 358 -      if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0)
 359 -       printf_filtered (_("Contents of blank COMMON block:\n"));
 360 +      if (comname)
 361 +       printf_filtered (_("No common block '%s'.\n"), comname);
 362        else
 363 -       printf_filtered (_("Contents of F77 COMMON block '%s':\n"), comname);
 364 -
 365 -      printf_filtered ("\n");
 366 -      entry = the_common->entries;
 367 -
 368 -      while (entry != NULL)
 369 -       {
 370 -         fi = frame_find_by_id (frame_id);
 371 -         if (fi == NULL)
 372 -           {
 373 -             warning (_("Unable to restore previously selected frame."));
 374 -             break;
 375 -           }
 376 -
 377 -         print_variable_and_value (NULL, entry->symbol, fi, gdb_stdout, 0);
 378 -
 379 -         /* print_variable_and_value invalidates FI.  */
 380 -         fi = NULL;
 381 -
 382 -         entry = entry->next;
 383 -       }
 384 +       printf_filtered (_("No common blocks.\n"));
 385      }
 386 -  else
 387 -    printf_filtered (_("Cannot locate the common block %s in function '%s'\n"),
 388 -                    comname, funname);
 389  }
 390
 391  void
 392 Index: gdb-7.4.91.20120801/gdb/stack.c
 393 ===================================================================
 394 --- gdb-7.4.91.20120801.orig/gdb/stack.c        2012-08-01 18:36:51.000000000 +0200
 395 +++ gdb-7.4.91.20120801/gdb/stack.c     2012-08-01 18:38:54.206540471 +0200
 396 @@ -1851,6 +1851,8 @@ iterate_over_block_locals (struct block
 397         case LOC_COMPUTED:
 398           if (SYMBOL_IS_ARGUMENT (sym))
 399             break;
 400 +         if (SYMBOL_DOMAIN (sym) == COMMON_BLOCK_DOMAIN)
 401 +           break;
 402           (*cb) (SYMBOL_PRINT_NAME (sym), sym, cb_data);
 403           break;
 404
 405 Index: gdb-7.4.91.20120801/gdb/symtab.h
 406 ===================================================================
 407 --- gdb-7.4.91.20120801.orig/gdb/symtab.h       2012-06-30 00:46:46.000000000 +0200
 408 +++ gdb-7.4.91.20120801/gdb/symtab.h    2012-08-01 18:38:54.206540471 +0200
 409 @@ -394,7 +394,10 @@ typedef enum domain_enum_tag
 410
 411    /* LABEL_DOMAIN may be used for names of labels (for gotos).  */
 412
 413 -  LABEL_DOMAIN
 414 +  LABEL_DOMAIN,
 415 +
 416 +  /* Fortran common blocks.  Their naming must be separate from VAR_DOMAIN.  */
 417 +  COMMON_BLOCK_DOMAIN
 418  } domain_enum;
 419
 420  /* Searching domains, used for `search_symbols'.  Element numbers are
 421 Index: gdb-7.4.91.20120801/gdb/testsuite/gdb.fortran/common-block.exp
 422 ===================================================================
 423 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
 424 +++ gdb-7.4.91.20120801/gdb/testsuite/gdb.fortran/common-block.exp      2012-08-01 18:38:54.207540465 +0200
 425 @@ -0,0 +1,101 @@
 426 +# Copyright 2008 Free Software Foundation, Inc.
 427 +
 428 +# This program is free software; you can redistribute it and/or modify
 429 +# it under the terms of the GNU General Public License as published by
 430 +# the Free Software Foundation; either version 2 of the License, or
 431 +# (at your option) any later version.
 432 +#
 433 +# This program is distributed in the hope that it will be useful,
 434 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
 435 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 436 +# GNU General Public License for more details.
 437 +#
 438 +# You should have received a copy of the GNU General Public License
 439 +# along with this program; if not, write to the Free Software
 440 +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 441 +
 442 +# This file was written by Jan Kratochvil <jan.kratochvil@redhat.com>.
 443 +
 444 +set testfile "common-block"
 445 +set srcfile ${testfile}.f90
 446 +set binfile ${objdir}/${subdir}/${testfile}
 447 +
 448 +if  { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f90 quiet}] != "" } {
 449 +    untested "Couldn't compile ${srcfile}"
 450 +    return -1
 451 +}
 452 +
 453 +gdb_exit
 454 +gdb_start
 455 +gdb_reinitialize_dir $srcdir/$subdir
 456 +gdb_load ${binfile}
 457 +
 458 +if ![runto MAIN__] then {
 459 +    perror "couldn't run to breakpoint MAIN__"
 460 +    continue
 461 +}
 462 +
 463 +gdb_breakpoint [gdb_get_line_number "stop-here-out"]
 464 +gdb_continue_to_breakpoint "stop-here-out"
 465 +
 466 +# Common block naming with source name /foo/:
 467 +#                .symtab  DW_TAG_common_block's DW_AT_name
 468 +# Intel Fortran  foo_     foo_
 469 +# GNU Fortran    foo_     foo
 470 +#set suffix "_"
 471 +set suffix ""
 472 +
 473 +set int4 {(integer\(kind=4\)|INTEGER\(4\))}
 474 +set real4 {(real\(kind=4\)|REAL\(4\))}
 475 +set real8 {(real\(kind=8\)|REAL\(8\))}
 476 +
 477 +gdb_test "whatis foo$suffix" "No symbol \"foo$suffix\" in current context."
 478 +gdb_test "ptype foo$suffix" "No symbol \"foo$suffix\" in current context."
 479 +gdb_test "p foo$suffix" "No symbol \"foo$suffix\" in current context."
 480 +gdb_test "whatis fo_o$suffix" "No symbol \"fo_o$suffix\" in current context."
 481 +gdb_test "ptype fo_o$suffix" "No symbol \"fo_o$suffix\" in current context."
 482 +gdb_test "p fo_o$suffix" "No symbol \"fo_o$suffix\" in current context."
 483 +
 484 +gdb_test "info locals" "ix_x = 11\r\niy_y = 22\r\niz_z = 33\r\nix = 1\r\niy = 2\r\niz = 3" "info locals out"
 485 +gdb_test "info common" "Contents of F77 COMMON block 'fo_o':\r\nix_x = 11\r\niy_y = 22\r\niz_z = 33\r\n\r\nContents of F77 COMMON block 'foo':\r\nix = 1\r\niy = 2\r\niz = 3" "info common out"
 486 +
 487 +gdb_test "ptype ix" "type = $int4" "ptype ix out"
 488 +gdb_test "ptype iy" "type = $real4" "ptype iy out"
 489 +gdb_test "ptype iz" "type = $real8" "ptype iz out"
 490 +gdb_test "ptype ix_x" "type = $int4" "ptype ix_x out"
 491 +gdb_test "ptype iy_y" "type = $real4" "ptype iy_y out"
 492 +gdb_test "ptype iz_z" "type = $real8" "ptype iz_z out"
 493 +
 494 +gdb_test "p ix" " = 1 *" "p ix out"
 495 +gdb_test "p iy" " = 2 *" "p iy out"
 496 +gdb_test "p iz" " = 3 *" "p iz out"
 497 +gdb_test "p ix_x" " = 11 *" "p ix_x out"
 498 +gdb_test "p iy_y" " = 22 *" "p iy_y out"
 499 +gdb_test "p iz_z" " = 33 *" "p iz_z out"
 500 +
 501 +gdb_breakpoint [gdb_get_line_number "stop-here-in"]
 502 +gdb_continue_to_breakpoint "stop-here-in"
 503 +
 504 +gdb_test "whatis foo$suffix" "No symbol \"foo$suffix\" in current context." "whatis foo$suffix in"
 505 +gdb_test "ptype foo$suffix" "No symbol \"foo$suffix\" in current context." "ptype foo$suffix in"
 506 +gdb_test "p foo$suffix" "No symbol \"foo$suffix\" in current context." "p foo$suffix in"
 507 +gdb_test "whatis fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "whatis fo_o$suffix in"
 508 +gdb_test "ptype fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "ptype fo_o$suffix in"
 509 +gdb_test "p fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "p fo_o$suffix in"
 510 +
 511 +gdb_test "info locals" "ix = 11\r\niy2 = 22\r\niz = 33\r\nix_x = 1\r\niy_y = 2\r\niz_z2 = 3\r\niy = 5\r\niz_z = 55" "info locals in"
 512 +gdb_test "info common" "Contents of F77 COMMON block 'fo_o':\r\nix = 11\r\niy2 = 22\r\niz = 33\r\n\r\nContents of F77 COMMON block 'foo':\r\nix_x = 1\r\niy_y = 2\r\niz_z2 = 3" "info common in"
 513 +
 514 +gdb_test "ptype ix" "type = $int4" "ptype ix in"
 515 +gdb_test "ptype iy2" "type = $real4" "ptype iy2 in"
 516 +gdb_test "ptype iz" "type = $real8" "ptype iz in"
 517 +gdb_test "ptype ix_x" "type = $int4" "ptype ix_x in"
 518 +gdb_test "ptype iy_y" "type = $real4" "ptype iy_y in"
 519 +gdb_test "ptype iz_z2" "type = $real8" "ptype iz_z2 in"
 520 +
 521 +gdb_test "p ix" " = 11 *" "p ix in"
 522 +gdb_test "p iy2" " = 22 *" "p iy2 in"
 523 +gdb_test "p iz" " = 33 *" "p iz in"
 524 +gdb_test "p ix_x" " = 1 *" "p ix_x in"
 525 +gdb_test "p iy_y" " = 2 *" "p iy_y in"
 526 +gdb_test "p iz_z2" " = 3 *" "p iz_z2 in"
 527 Index: gdb-7.4.91.20120801/gdb/testsuite/gdb.fortran/common-block.f90
 528 ===================================================================
 529 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
 530 +++ gdb-7.4.91.20120801/gdb/testsuite/gdb.fortran/common-block.f90      2012-08-01 18:38:54.207540465 +0200
 531 @@ -0,0 +1,67 @@
 532 +! Copyright 2008 Free Software Foundation, Inc.
 533 +!
 534 +! This program is free software; you can redistribute it and/or modify
 535 +! it under the terms of the GNU General Public License as published by
 536 +! the Free Software Foundation; either version 2 of the License, or
 537 +! (at your option) any later version.
 538 +!
 539 +! This program is distributed in the hope that it will be useful,
 540 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
 541 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 542 +! GNU General Public License for more details.
 543 +!
 544 +! You should have received a copy of the GNU General Public License
 545 +! along with this program; if not, write to the Free Software
 546 +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 547 +!
 548 +! Ihis file is the Fortran source file for dynamic.exp.
 549 +! Original file written by Jakub Jelinek <jakub@redhat.com>.
 550 +! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@redhat.com>.
 551 +
 552 +subroutine in
 553 +
 554 +   INTEGER*4            ix
 555 +   REAL*4               iy2
 556 +   REAL*8               iz
 557 +
 558 +   INTEGER*4            ix_x
 559 +   REAL*4               iy_y
 560 +   REAL*8               iz_z2
 561 +
 562 +   common /fo_o/ix,iy2,iz
 563 +   common /foo/ix_x,iy_y,iz_z2
 564 +
 565 +   iy = 5
 566 +   iz_z = 55
 567 +
 568 +   if (ix .ne. 11 .or. iy2 .ne. 22.0 .or. iz .ne. 33.0) call abort
 569 +   if (ix_x .ne. 1 .or. iy_y .ne. 2.0 .or. iz_z2 .ne. 3.0) call abort
 570 +
 571 +   ix = 0                                      ! stop-here-in
 572 +
 573 +end subroutine in
 574 +
 575 +program common_test
 576 +
 577 +   INTEGER*4            ix
 578 +   REAL*4               iy
 579 +   REAL*8               iz
 580 +
 581 +   INTEGER*4            ix_x
 582 +   REAL*4               iy_y
 583 +   REAL*8               iz_z
 584 +
 585 +   common /foo/ix,iy,iz
 586 +   common /fo_o/ix_x,iy_y,iz_z
 587 +
 588 +   ix = 1
 589 +   iy = 2.0
 590 +   iz = 3.0
 591 +
 592 +   ix_x = 11
 593 +   iy_y = 22.0
 594 +   iz_z = 33.0
 595 +
 596 +   call in                                     ! stop-here-out
 597 +
 598 +end program common_test