2012-09-26 Jan Kratochvil <jan.kratochvil@redhat.com>

Tom Tromey  <tromey@redhat.com>
	* dwarf2read.c (read_common_block): Rewrite.
	(new_symbol_full): Handle DW_TAG_common_block.
	* f-lang.c (head_common_list, find_common_for_function):
	Remove.
	* f-lang.h (struct common_entry, struct saved_f77_common,
	SAVED_F77_COMMON, SAVED_F77_COMMON_PTR, COMMON_ENTRY,
	COMMON_ENTRY_PTR, head_common_list, find_common_for_function,
	BLANK_COMMON_NAME_LOCAL): Remove.
	(struct common_block): New.
	* f-valprint.c (list_all_visible_commons): Remove.
	(info_common_command_for_block): New function.
	(info_common_command): Use it.
	* stack.c (iterate_over_block_locals): Special case for
	COMMON_BLOCK_DOMAIN.
	* symtab.h (enum domain_enum_tag) <COMMON_BLOCK_DOMAIN>: New
	constant.
	(struct general_symbol_info) <value.common_block>: New field.
	(SYMBOL_VALUE_COMMON_BLOCK): New define.
gdb/testsuite
2012-09-26  Jan Kratochvil  <jan.kratochvil@redhat.com>
	* gdb.fortran/common-block.exp: New file.
	* gdb.fortran/common-block.f90: New file.
This commit is contained in:
Tom Tromey 2012-09-26 19:38:32 +00:00
parent 965f07a88d
commit 4357ac6c6f
10 changed files with 327 additions and 175 deletions

View File

@ -1,3 +1,25 @@
2012-09-26 Jan Kratochvil <jan.kratochvil@redhat.com>
Tom Tromey <tromey@redhat.com>
* dwarf2read.c (read_common_block): Rewrite.
(new_symbol_full): Handle DW_TAG_common_block.
* f-lang.c (head_common_list, find_common_for_function):
Remove.
* f-lang.h (struct common_entry, struct saved_f77_common,
SAVED_F77_COMMON, SAVED_F77_COMMON_PTR, COMMON_ENTRY,
COMMON_ENTRY_PTR, head_common_list, find_common_for_function,
BLANK_COMMON_NAME_LOCAL): Remove.
(struct common_block): New.
* f-valprint.c (list_all_visible_commons): Remove.
(info_common_command_for_block): New function.
(info_common_command): Use it.
* stack.c (iterate_over_block_locals): Special case for
COMMON_BLOCK_DOMAIN.
* symtab.h (enum domain_enum_tag) <COMMON_BLOCK_DOMAIN>: New
constant.
(struct general_symbol_info) <value.common_block>: New field.
(SYMBOL_VALUE_COMMON_BLOCK): New define.
2012-09-26 Jan Kratochvil <jan.kratochvil@redhat.com>
Tom Tromey <tromey@redhat.com>

View File

@ -65,6 +65,7 @@
#include "gdb/gdb-index.h"
#include <ctype.h>
#include "gdb_bfd.h"
#include "f-lang.h"
#include <fcntl.h>
#include "gdb_string.h"
@ -11063,50 +11064,47 @@ read_set_type (struct die_info *die, struct dwarf2_cu *cu)
return set_die_type (die, set_type, cu);
}
/* First cut: install each common block member as a global variable. */
/* Create appropriate locally-scoped variables for all the
DW_TAG_common_block entries. Also create a struct common_block
listing all such variables for `info common'. COMMON_BLOCK_DOMAIN
is used to sepate the common blocks name namespace from regular
variable names. */
static void
read_common_block (struct die_info *die, struct dwarf2_cu *cu)
{
struct die_info *child_die;
struct attribute *attr;
struct symbol *sym;
CORE_ADDR base = (CORE_ADDR) 0;
attr = dwarf2_attr (die, DW_AT_location, cu);
if (attr)
{
/* Support the .debug_loc offsets. */
if (attr_form_is_block (attr))
{
base = decode_locdesc (DW_BLOCK (attr), cu);
}
else if (attr_form_is_section_offset (attr))
{
dwarf2_complex_location_expr_complaint ();
}
else
{
dwarf2_invalid_attrib_class_complaint ("DW_AT_location",
"common block member");
}
}
if (die->child != NULL)
{
child_die = die->child;
while (child_die && child_die->tag)
{
LONGEST offset;
struct objfile *objfile = cu->objfile;
struct die_info *child_die;
size_t n_entries = 0, size;
struct common_block *common_block;
struct symbol *sym;
for (child_die = die->child;
child_die && child_die->tag;
child_die = sibling_die (child_die))
++n_entries;
size = (sizeof (struct common_block)
+ (n_entries - 1) * sizeof (struct symbol *));
common_block = obstack_alloc (&objfile->objfile_obstack, size);
memset (common_block->contents, 0, n_entries * sizeof (struct symbol *));
common_block->n_entries = 0;
for (child_die = die->child;
child_die && child_die->tag;
child_die = sibling_die (child_die))
{
/* Create the symbol in the DW_TAG_common_block block in the current
symbol scope. */
sym = new_symbol (child_die, NULL, cu);
if (sym != NULL
&& handle_data_member_location (child_die, cu, &offset))
{
SYMBOL_VALUE_ADDRESS (sym) = base + offset;
add_symbol_to_list (sym, &global_symbols);
}
child_die = sibling_die (child_die);
if (sym)
common_block->contents[common_block->n_entries++] = sym;
}
sym = new_symbol (die, objfile_type (objfile)->builtin_void, cu);
SYMBOL_VALUE_COMMON_BLOCK (sym) = common_block;
}
}
@ -14956,6 +14954,13 @@ new_symbol_full (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
{
var_decode_location (attr, sym, cu);
attr2 = dwarf2_attr (die, DW_AT_external, cu);
/* Fortran explicitly imports any global symbols to the local
scope by DW_TAG_common_block. */
if (cu->language == language_fortran && die->parent
&& die->parent->tag == DW_TAG_common_block)
attr2 = NULL;
if (SYMBOL_CLASS (sym) == LOC_STATIC
&& SYMBOL_VALUE_ADDRESS (sym) == 0
&& !dwarf2_per_objfile->has_section_at_zero)
@ -15120,6 +15125,11 @@ new_symbol_full (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
SYMBOL_CLASS (sym) = LOC_TYPEDEF;
list_to_add = &global_symbols;
break;
case DW_TAG_common_block:
SYMBOL_CLASS (sym) = LOC_STATIC;
SYMBOL_DOMAIN (sym) = COMMON_BLOCK_DOMAIN;
add_symbol_to_list (sym, cu->list_in_scope);
break;
default:
/* Not a tag we recognize. Hopefully we aren't processing
trash data, but since we must specifically ignore things

View File

@ -349,27 +349,3 @@ _initialize_f_language (void)
add_language (&f_language_defn);
}
SAVED_F77_COMMON_PTR head_common_list = NULL; /* Ptr to 1st saved COMMON */
/* This routine finds the first encountred COMMON block named "name"
that belongs to function funcname. */
SAVED_F77_COMMON_PTR
find_common_for_function (const char *name, const char *funcname)
{
SAVED_F77_COMMON_PTR tmp;
tmp = head_common_list;
while (tmp != NULL)
{
if (strcmp (tmp->name, name) == 0
&& strcmp (tmp->owning_function, funcname) == 0)
return (tmp);
else
tmp = tmp->next;
}
return (NULL);
}

View File

@ -48,33 +48,17 @@ enum f90_range_type
NONE_BOUND_DEFAULT /* "(low:high)" */
};
struct common_entry
{
struct symbol *symbol; /* The symbol node corresponding
to this component */
struct common_entry *next; /* The next component */
};
/* A common block. */
struct saved_f77_common
{
char *name; /* Name of COMMON */
char *owning_function; /* Name of parent function */
int secnum; /* Section # of .bss */
CORE_ADDR offset; /* Offset from .bss for
this block */
struct common_entry *entries; /* List of block's components */
struct common_entry *end_of_entries; /* ptr. to end of components */
struct saved_f77_common *next; /* Next saved COMMON block */
};
struct common_block
{
/* The number of entries in the block. */
size_t n_entries;
typedef struct saved_f77_common SAVED_F77_COMMON, *SAVED_F77_COMMON_PTR;
typedef struct common_entry COMMON_ENTRY, *COMMON_ENTRY_PTR;
extern SAVED_F77_COMMON_PTR head_common_list; /* Ptr to 1st saved COMMON */
extern SAVED_F77_COMMON_PTR find_common_for_function (const char *,
const char *);
/* The contents of the block, allocated using the struct hack. All
pointers in the array are non-NULL. */
struct symbol *contents[1];
};
#define BLANK_COMMON_NAME_LOCAL "__BLANK" /* Local GDB */

View File

@ -34,10 +34,12 @@
#include "gdbcore.h"
#include "command.h"
#include "block.h"
#include "dictionary.h"
#include "gdb_assert.h"
#include "exceptions.h"
extern void _initialize_f_valprint (void);
static void info_common_command (char *, int);
static void list_all_visible_commons (const char *);
static void f77_create_arrayprint_offset_tbl (struct type *,
struct ui_file *);
static void f77_get_dynamic_length_of_aggregate (struct type *);
@ -410,21 +412,57 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
}
static void
list_all_visible_commons (const char *funname)
info_common_command_for_block (struct block *block, const char *comname,
int *any_printed)
{
SAVED_F77_COMMON_PTR tmp;
struct block_iterator iter;
struct symbol *sym;
const char *name;
struct value_print_options opts;
tmp = head_common_list;
get_user_print_options (&opts);
printf_filtered (_("All COMMON blocks visible at this level:\n\n"));
ALL_BLOCK_SYMBOLS (block, iter, sym)
if (SYMBOL_DOMAIN (sym) == COMMON_BLOCK_DOMAIN)
{
struct common_block *common = SYMBOL_VALUE_COMMON_BLOCK (sym);
size_t index;
while (tmp != NULL)
{
if (strcmp (tmp->owning_function, funname) == 0)
printf_filtered ("%s\n", tmp->name);
gdb_assert (SYMBOL_CLASS (sym) == LOC_STATIC);
tmp = tmp->next;
}
if (comname && (!SYMBOL_LINKAGE_NAME (sym)
|| strcmp (comname, SYMBOL_LINKAGE_NAME (sym)) != 0))
continue;
if (*any_printed)
putchar_filtered ('\n');
else
*any_printed = 1;
if (SYMBOL_PRINT_NAME (sym))
printf_filtered (_("Contents of F77 COMMON block '%s':\n"),
SYMBOL_PRINT_NAME (sym));
else
printf_filtered (_("Contents of blank COMMON block:\n"));
for (index = 0; index < common->n_entries; index++)
{
struct value *val = NULL;
volatile struct gdb_exception except;
printf_filtered ("%s = ",
SYMBOL_PRINT_NAME (common->contents[index]));
TRY_CATCH (except, RETURN_MASK_ERROR)
{
val = value_of_variable (common->contents[index], block);
value_print (val, gdb_stdout, &opts);
}
if (except.reason < 0)
printf_filtered ("<error reading variable: %s>", except.message);
putchar_filtered ('\n');
}
}
}
/* This function is used to print out the values in a given COMMON
@ -434,11 +472,9 @@ list_all_visible_commons (const char *funname)
static void
info_common_command (char *comname, int from_tty)
{
SAVED_F77_COMMON_PTR the_common;
COMMON_ENTRY_PTR entry;
struct frame_info *fi;
const char *funname = 0;
struct symbol *func;
struct block *block;
int values_printed = 0;
/* We have been told to display the contents of F77 COMMON
block supposedly visible in this function. Let us
@ -450,87 +486,30 @@ info_common_command (char *comname, int from_tty)
/* The following is generally ripped off from stack.c's routine
print_frame_info(). */
func = find_pc_function (get_frame_pc (fi));
if (func)
block = get_frame_block (fi, 0);
if (block == NULL)
{
/* In certain pathological cases, the symtabs give the wrong
function (when we are in the first function in a file which
is compiled without debugging symbols, the previous function
is compiled with debugging symbols, and the "foo.o" symbol
that is supposed to tell us where the file with debugging symbols
ends has been truncated by ar because it is longer than 15
characters).
So look in the minimal symbol tables as well, and if it comes
up with a larger address for the function use that instead.
I don't think this can ever cause any problems; there shouldn't
be any minimal symbols in the middle of a function.
FIXME: (Not necessarily true. What about text labels?) */
struct minimal_symbol *msymbol =
lookup_minimal_symbol_by_pc (get_frame_pc (fi));
if (msymbol != NULL
&& (SYMBOL_VALUE_ADDRESS (msymbol)
> BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
funname = SYMBOL_LINKAGE_NAME (msymbol);
else
funname = SYMBOL_LINKAGE_NAME (func);
}
else
{
struct minimal_symbol *msymbol =
lookup_minimal_symbol_by_pc (get_frame_pc (fi));
if (msymbol != NULL)
funname = SYMBOL_LINKAGE_NAME (msymbol);
else /* Got no 'funname', code below will fail. */
error (_("No function found for frame."));
}
/* If comname is NULL, we assume the user wishes to see the
which COMMON blocks are visible here and then return. */
if (comname == 0)
{
list_all_visible_commons (funname);
printf_filtered (_("No symbol table info available.\n"));
return;
}
the_common = find_common_for_function (comname, funname);
if (the_common)
while (block)
{
struct frame_id frame_id = get_frame_id (fi);
if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0)
printf_filtered (_("Contents of blank COMMON block:\n"));
else
printf_filtered (_("Contents of F77 COMMON block '%s':\n"), comname);
printf_filtered ("\n");
entry = the_common->entries;
while (entry != NULL)
{
fi = frame_find_by_id (frame_id);
if (fi == NULL)
{
warning (_("Unable to restore previously selected frame."));
break;
}
print_variable_and_value (NULL, entry->symbol, fi, gdb_stdout, 0);
/* print_variable_and_value invalidates FI. */
fi = NULL;
entry = entry->next;
}
info_common_command_for_block (block, comname, &values_printed);
/* After handling the function's top-level block, stop. Don't
continue to its superblock, the block of per-file symbols. */
if (BLOCK_FUNCTION (block))
break;
block = BLOCK_SUPERBLOCK (block);
}
if (!values_printed)
{
if (comname)
printf_filtered (_("No common block '%s'.\n"), comname);
else
printf_filtered (_("No common blocks.\n"));
}
else
printf_filtered (_("Cannot locate the common block %s in function '%s'\n"),
comname, funname);
}
void

View File

@ -1848,6 +1848,8 @@ iterate_over_block_locals (struct block *b,
case LOC_COMPUTED:
if (SYMBOL_IS_ARGUMENT (sym))
break;
if (SYMBOL_DOMAIN (sym) == COMMON_BLOCK_DOMAIN)
break;
(*cb) (SYMBOL_PRINT_NAME (sym), sym, cb_data);
break;

View File

@ -37,6 +37,7 @@ struct agent_expr;
struct program_space;
struct language_defn;
struct probe;
struct common_block;
/* Some of the structures in this file are space critical.
The space-critical structures are:
@ -119,6 +120,10 @@ struct general_symbol_info
CORE_ADDR address;
/* A common block. Used with COMMON_BLOCK_DOMAIN. */
struct common_block *common_block;
/* For opaque typedef struct chain. */
struct symbol *chain;
@ -181,6 +186,7 @@ extern CORE_ADDR symbol_overlayed_address (CORE_ADDR, struct obj_section *);
#define SYMBOL_VALUE(symbol) (symbol)->ginfo.value.ivalue
#define SYMBOL_VALUE_ADDRESS(symbol) (symbol)->ginfo.value.address
#define SYMBOL_VALUE_BYTES(symbol) (symbol)->ginfo.value.bytes
#define SYMBOL_VALUE_COMMON_BLOCK(symbol) (symbol)->ginfo.value.common_block
#define SYMBOL_BLOCK_VALUE(symbol) (symbol)->ginfo.value.block
#define SYMBOL_VALUE_CHAIN(symbol) (symbol)->ginfo.value.chain
#define SYMBOL_LANGUAGE(symbol) (symbol)->ginfo.language
@ -406,7 +412,10 @@ typedef enum domain_enum_tag
/* LABEL_DOMAIN may be used for names of labels (for gotos). */
LABEL_DOMAIN
LABEL_DOMAIN,
/* Fortran common blocks. Their naming must be separate from VAR_DOMAIN. */
COMMON_BLOCK_DOMAIN
} domain_enum;
/* Searching domains, used for `search_symbols'. Element numbers are

View File

@ -1,3 +1,8 @@
2012-09-26 Jan Kratochvil <jan.kratochvil@redhat.com>
* gdb.fortran/common-block.exp: New file.
* gdb.fortran/common-block.f90: New file.
2012-09-26 Andrew Burgess <aburgess@broadcom.com>
* gdb.base/duplicate-bp.c: New file.

View File

@ -0,0 +1,98 @@
# Copyright 2008, 2012 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# 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.
# This file was written by Jan Kratochvil <jan.kratochvil@redhat.com>.
if {[skip_fortran_tests]} {
return 0
}
standard_testfile .f90
if {[prepare_for_testing ${testfile}.exp ${testfile} \
$srcfile {debug f90 quiet}]} {
return -1
}
if ![runto MAIN__] then {
perror "couldn't run to breakpoint MAIN__"
continue
}
gdb_breakpoint [gdb_get_line_number "stop-here-out"]
gdb_continue_to_breakpoint "stop-here-out"
# Common block naming with source name /foo/:
# .symtab DW_TAG_common_block's DW_AT_name
# Intel Fortran foo_ foo_
# GNU Fortran foo_ foo
#set suffix "_"
set suffix ""
set int4 {(integer\(kind=4\)|INTEGER\(4\))}
set real4 {(real\(kind=4\)|REAL\(4\))}
set real8 {(real\(kind=8\)|REAL\(8\))}
gdb_test "whatis foo$suffix" "No symbol \"foo$suffix\" in current context."
gdb_test "ptype foo$suffix" "No symbol \"foo$suffix\" in current context."
gdb_test "p foo$suffix" "No symbol \"foo$suffix\" in current context."
gdb_test "whatis fo_o$suffix" "No symbol \"fo_o$suffix\" in current context."
gdb_test "ptype fo_o$suffix" "No symbol \"fo_o$suffix\" in current context."
gdb_test "p fo_o$suffix" "No symbol \"fo_o$suffix\" in current context."
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"
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"
gdb_test "ptype ix" "type = $int4" "ptype ix out"
gdb_test "ptype iy" "type = $real4" "ptype iy out"
gdb_test "ptype iz" "type = $real8" "ptype iz out"
gdb_test "ptype ix_x" "type = $int4" "ptype ix_x out"
gdb_test "ptype iy_y" "type = $real4" "ptype iy_y out"
gdb_test "ptype iz_z" "type = $real8" "ptype iz_z out"
gdb_test "p ix" " = 1 *" "p ix out"
gdb_test "p iy" " = 2 *" "p iy out"
gdb_test "p iz" " = 3 *" "p iz out"
gdb_test "p ix_x" " = 11 *" "p ix_x out"
gdb_test "p iy_y" " = 22 *" "p iy_y out"
gdb_test "p iz_z" " = 33 *" "p iz_z out"
gdb_breakpoint [gdb_get_line_number "stop-here-in"]
gdb_continue_to_breakpoint "stop-here-in"
gdb_test "whatis foo$suffix" "No symbol \"foo$suffix\" in current context." "whatis foo$suffix in"
gdb_test "ptype foo$suffix" "No symbol \"foo$suffix\" in current context." "ptype foo$suffix in"
gdb_test "p foo$suffix" "No symbol \"foo$suffix\" in current context." "p foo$suffix in"
gdb_test "whatis fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "whatis fo_o$suffix in"
gdb_test "ptype fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "ptype fo_o$suffix in"
gdb_test "p fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "p fo_o$suffix in"
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"
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"
gdb_test "ptype ix" "type = $int4" "ptype ix in"
gdb_test "ptype iy2" "type = $real4" "ptype iy2 in"
gdb_test "ptype iz" "type = $real8" "ptype iz in"
gdb_test "ptype ix_x" "type = $int4" "ptype ix_x in"
gdb_test "ptype iy_y" "type = $real4" "ptype iy_y in"
gdb_test "ptype iz_z2" "type = $real8" "ptype iz_z2 in"
gdb_test "p ix" " = 11 *" "p ix in"
gdb_test "p iy2" " = 22 *" "p iy2 in"
gdb_test "p iz" " = 33 *" "p iz in"
gdb_test "p ix_x" " = 1 *" "p ix_x in"
gdb_test "p iy_y" " = 2 *" "p iy_y in"
gdb_test "p iz_z2" " = 3 *" "p iz_z2 in"

View File

@ -0,0 +1,67 @@
! Copyright 2008, 2012 Free Software Foundation, Inc.
!
! This program is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 3 of the License, or
! (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! 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.
!
! Ihis file is the Fortran source file for dynamic.exp.
! Original file written by Jakub Jelinek <jakub@redhat.com>.
! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@redhat.com>.
subroutine in
INTEGER*4 ix
REAL*4 iy2
REAL*8 iz
INTEGER*4 ix_x
REAL*4 iy_y
REAL*8 iz_z2
common /fo_o/ix,iy2,iz
common /foo/ix_x,iy_y,iz_z2
iy = 5
iz_z = 55
if (ix .ne. 11 .or. iy2 .ne. 22.0 .or. iz .ne. 33.0) call abort
if (ix_x .ne. 1 .or. iy_y .ne. 2.0 .or. iz_z2 .ne. 3.0) call abort
ix = 0 ! stop-here-in
end subroutine in
program common_test
INTEGER*4 ix
REAL*4 iy
REAL*8 iz
INTEGER*4 ix_x
REAL*4 iy_y
REAL*8 iz_z
common /foo/ix,iy,iz
common /fo_o/ix_x,iy_y,iz_z
ix = 1
iy = 2.0
iz = 3.0
ix_x = 11
iy_y = 22.0
iz_z = 33.0
call in ! stop-here-out
end program common_test