diff options
| -rw-r--r-- | gdb/ChangeLog | 22 | ||||
| -rw-r--r-- | gdb/dwarf2read.c | 80 | ||||
| -rw-r--r-- | gdb/f-lang.c | 24 | ||||
| -rw-r--r-- | gdb/f-lang.h | 34 | ||||
| -rw-r--r-- | gdb/f-valprint.c | 161 | ||||
| -rw-r--r-- | gdb/stack.c | 2 | ||||
| -rw-r--r-- | gdb/symtab.h | 11 | ||||
| -rw-r--r-- | gdb/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/common-block.exp | 98 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/common-block.f90 | 67 |
10 files changed, 328 insertions, 176 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 300447fa281..792df94d72a 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,6 +1,28 @@ 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> + * f-lang.c (allocate_saved_bf_node, allocate_saved_function_node, allocate_saved_f77_common_node, allocate_common_entry_node, tail_common_list, current_common, diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c index 758bd3bcbbf..87285e3f7f0 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -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 diff --git a/gdb/f-lang.c b/gdb/f-lang.c index 3be49afd6d0..0b3645f9093 100644 --- a/gdb/f-lang.c +++ b/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); -} diff --git a/gdb/f-lang.h b/gdb/f-lang.h index 94001e86bf6..0d3a0c1e68d 100644 --- a/gdb/f-lang.h +++ b/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 */ - }; - -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 */ - }; +/* A common block. */ -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 */ +struct common_block +{ + /* The number of entries in the block. */ + size_t n_entries; -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 */ diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c index 4f165ced032..c3d23833173 100644 --- a/gdb/f-valprint.c +++ b/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; - - tmp = head_common_list; - - printf_filtered (_("All COMMON blocks visible at this level:\n\n")); - - while (tmp != NULL) - { - if (strcmp (tmp->owning_function, funname) == 0) - printf_filtered ("%s\n", tmp->name); - - tmp = tmp->next; - } + struct block_iterator iter; + struct symbol *sym; + const char *name; + struct value_print_options opts; + + get_user_print_options (&opts); + + 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; + + gdb_assert (SYMBOL_CLASS (sym) == LOC_STATIC); + + 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.")); + printf_filtered (_("No symbol table info available.\n")); + return; } - /* If comname is NULL, we assume the user wishes to see the - which COMMON blocks are visible here and then return. */ - - if (comname == 0) + while (block) { - list_all_visible_commons (funname); - return; + 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); } - the_common = find_common_for_function (comname, funname); - - if (the_common) + if (!values_printed) { - 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")); + if (comname) + printf_filtered (_("No common block '%s'.\n"), comname); 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; - } + printf_filtered (_("No common blocks.\n")); } - else - printf_filtered (_("Cannot locate the common block %s in function '%s'\n"), - comname, funname); } void diff --git a/gdb/stack.c b/gdb/stack.c index 2c03f42ca97..b01c8f0b077 100644 --- a/gdb/stack.c +++ b/gdb/stack.c @@ -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; diff --git a/gdb/symtab.h b/gdb/symtab.h index 041d8cf199b..b74fbe4718d 100644 --- a/gdb/symtab.h +++ b/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 diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 706b9ccdcb4..0fbd11b7a50 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -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. diff --git a/gdb/testsuite/gdb.fortran/common-block.exp b/gdb/testsuite/gdb.fortran/common-block.exp new file mode 100644 index 00000000000..61a98d4ebb1 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/common-block.exp @@ -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" diff --git a/gdb/testsuite/gdb.fortran/common-block.f90 b/gdb/testsuite/gdb.fortran/common-block.f90 new file mode 100644 index 00000000000..1ccfd3841d2 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/common-block.f90 @@ -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 |