]>
Commit | Line | Data |
---|---|---|
a7de96f0 | 1 | Index: gdb-7.4.91.20120801/gdb/dwarf2read.c |
51a5ef0f | 2 | =================================================================== |
a7de96f0 PS |
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 | |
51a5ef0f PS |
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; | |
a7de96f0 | 22 | @@ -11103,20 +11105,67 @@ read_common_block (struct die_info *die, |
51a5ef0f PS |
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 | { | |
6ed6bacf AM |
55 | LONGEST offset; |
56 | ||
51a5ef0f PS |
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? */ | |
6ed6bacf AM |
62 | if (sym != NULL |
63 | && handle_data_member_location (child_die, cu, &offset)) | |
51a5ef0f | 64 | { |
6ed6bacf | 65 | SYMBOL_VALUE_ADDRESS (sym) = base + offset; |
51a5ef0f PS |
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 | ||
a7de96f0 | 90 | @@ -15155,6 +15204,13 @@ new_symbol_full (struct die_info *die, s |
51a5ef0f PS |
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 | + | |
6ed6bacf AM |
101 | if (SYMBOL_CLASS (sym) == LOC_STATIC |
102 | && SYMBOL_VALUE_ADDRESS (sym) == 0 | |
103 | && !dwarf2_per_objfile->has_section_at_zero) | |
a7de96f0 | 104 | @@ -15319,6 +15375,11 @@ new_symbol_full (struct die_info *die, s |
51a5ef0f | 105 | SYMBOL_CLASS (sym) = LOC_TYPEDEF; |
6ed6bacf | 106 | list_to_add = &global_symbols; |
51a5ef0f PS |
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 | |
a7de96f0 | 116 | Index: gdb-7.4.91.20120801/gdb/f-lang.c |
51a5ef0f | 117 | =================================================================== |
a7de96f0 PS |
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) | |
51a5ef0f PS |
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" | |
6ed6bacf | 128 | - that belongs to function funcname. */ |
51a5ef0f PS |
129 | - |
130 | -SAVED_F77_COMMON_PTR | |
a7de96f0 | 131 | -find_common_for_function (const char *name, const char *funcname) |
51a5ef0f PS |
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 | -} | |
a7de96f0 | 148 | Index: gdb-7.4.91.20120801/gdb/f-lang.h |
51a5ef0f | 149 | =================================================================== |
a7de96f0 PS |
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 | |
51a5ef0f PS |
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 | - | |
a7de96f0 PS |
181 | -extern SAVED_F77_COMMON_PTR find_common_for_function (const char *, |
182 | - const char *); | |
51a5ef0f PS |
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 | |
a7de96f0 | 190 | Index: gdb-7.4.91.20120801/gdb/f-valprint.c |
51a5ef0f | 191 | =================================================================== |
a7de96f0 PS |
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 | |
f412e1b4 | 194 | @@ -34,10 +34,11 @@ |
51a5ef0f PS |
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); | |
a7de96f0 | 203 | -static void list_all_visible_commons (const char *); |
f412e1b4 PS |
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 *); | |
a7de96f0 PS |
207 | @@ -420,22 +421,53 @@ f_val_print (struct type *type, const gd |
208 | gdb_flush (stream); | |
51a5ef0f PS |
209 | } |
210 | ||
211 | -static void | |
a7de96f0 | 212 | -list_all_visible_commons (const char *funname) |
51a5ef0f | 213 | +static int |
a7de96f0 | 214 | +info_common_command_for_block (struct block *block, const char *comname) |
51a5ef0f PS |
215 | { |
216 | - SAVED_F77_COMMON_PTR tmp; | |
217 | - | |
218 | - tmp = head_common_list; | |
a7de96f0 | 219 | + struct block_iterator iter; |
51a5ef0f PS |
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")); | |
a7de96f0 | 260 | - |
51a5ef0f PS |
261 | - while (tmp != NULL) |
262 | - { | |
263 | - if (strcmp (tmp->owning_function, funname) == 0) | |
264 | - printf_filtered ("%s\n", tmp->name); | |
a7de96f0 PS |
265 | + putchar_filtered ('\n'); |
266 | + } | |
267 | ||
51a5ef0f PS |
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 | |
a7de96f0 | 274 | @@ -445,11 +477,9 @@ list_all_visible_commons (const char *fu |
51a5ef0f PS |
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; | |
a7de96f0 | 281 | - const char *funname = 0; |
51a5ef0f PS |
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 | |
a7de96f0 | 288 | @@ -461,87 +491,31 @@ info_common_command (char *comname, int |
51a5ef0f | 289 | /* The following is generally ripped off from stack.c's routine |
6ed6bacf | 290 | print_frame_info(). */ |
51a5ef0f PS |
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. | |
6ed6bacf | 309 | - FIXME: (Not necessarily true. What about text labels?) */ |
51a5ef0f PS |
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 | |
6ed6bacf | 335 | - which COMMON blocks are visible here and then return. */ |
51a5ef0f PS |
336 | - |
337 | - if (comname == 0) | |
338 | + while (block) | |
339 | { | |
340 | - list_all_visible_commons (funname); | |
341 | - return; | |
a7de96f0 | 342 | + if (info_common_command_for_block (block, comname)) |
51a5ef0f PS |
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 | { | |
a7de96f0 PS |
356 | - struct frame_id frame_id = get_frame_id (fi); |
357 | - | |
51a5ef0f PS |
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 | - { | |
a7de96f0 PS |
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 | - | |
51a5ef0f | 377 | - print_variable_and_value (NULL, entry->symbol, fi, gdb_stdout, 0); |
a7de96f0 PS |
378 | - |
379 | - /* print_variable_and_value invalidates FI. */ | |
380 | - fi = NULL; | |
381 | - | |
51a5ef0f PS |
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 | |
a7de96f0 | 392 | Index: gdb-7.4.91.20120801/gdb/stack.c |
51a5ef0f | 393 | =================================================================== |
a7de96f0 PS |
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 | |
51a5ef0f PS |
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 | ||
a7de96f0 | 405 | Index: gdb-7.4.91.20120801/gdb/symtab.h |
51a5ef0f | 406 | =================================================================== |
a7de96f0 PS |
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 | |
51a5ef0f | 410 | |
f412e1b4 PS |
411 | /* LABEL_DOMAIN may be used for names of labels (for gotos). */ |
412 | ||
413 | - LABEL_DOMAIN | |
414 | + LABEL_DOMAIN, | |
51a5ef0f PS |
415 | + |
416 | + /* Fortran common blocks. Their naming must be separate from VAR_DOMAIN. */ | |
417 | + COMMON_BLOCK_DOMAIN | |
f412e1b4 | 418 | } domain_enum; |
51a5ef0f | 419 | |
f412e1b4 | 420 | /* Searching domains, used for `search_symbols'. Element numbers are |
a7de96f0 | 421 | Index: gdb-7.4.91.20120801/gdb/testsuite/gdb.fortran/common-block.exp |
51a5ef0f PS |
422 | =================================================================== |
423 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
a7de96f0 | 424 | +++ gdb-7.4.91.20120801/gdb/testsuite/gdb.fortran/common-block.exp 2012-08-01 18:38:54.207540465 +0200 |
51a5ef0f PS |
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 | + | |
f412e1b4 | 448 | +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f90 quiet}] != "" } { |
51a5ef0f PS |
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" | |
a7de96f0 | 527 | Index: gdb-7.4.91.20120801/gdb/testsuite/gdb.fortran/common-block.f90 |
51a5ef0f PS |
528 | =================================================================== |
529 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
a7de96f0 | 530 | +++ gdb-7.4.91.20120801/gdb/testsuite/gdb.fortran/common-block.f90 2012-08-01 18:38:54.207540465 +0200 |
51a5ef0f PS |
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 |