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:
parent
965f07a88d
commit
4357ac6c6f
|
@ -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>
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
24
gdb/f-lang.c
24
gdb/f-lang.c
|
@ -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);
|
||||
}
|
||||
|
|
34
gdb/f-lang.h
34
gdb/f-lang.h
|
@ -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 */
|
||||
|
||||
|
|
159
gdb/f-valprint.c
159
gdb/f-valprint.c
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
11
gdb/symtab.h
11
gdb/symtab.h
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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"
|
|
@ -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
|
Loading…
Reference in New Issue