]>
Commit | Line | Data |
---|---|---|
f412e1b4 | 1 | Index: gdb-7.3.50.20110722/gdb/dwarf2read.c |
51a5ef0f | 2 | =================================================================== |
f412e1b4 PS |
3 | --- gdb-7.3.50.20110722.orig/gdb/dwarf2read.c 2011-07-22 20:12:05.000000000 +0200 |
4 | +++ gdb-7.3.50.20110722/gdb/dwarf2read.c 2011-07-22 20:17:22.000000000 +0200 | |
5 | @@ -7969,12 +7969,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; | |
f412e1b4 | 22 | @@ -7999,20 +8001,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 | ||
f412e1b4 | 90 | @@ -11695,6 +11744,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) | |
f412e1b4 | 104 | @@ -11867,6 +11923,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 | |
f412e1b4 | 116 | Index: gdb-7.3.50.20110722/gdb/f-lang.c |
51a5ef0f | 117 | =================================================================== |
f412e1b4 PS |
118 | --- gdb-7.3.50.20110722.orig/gdb/f-lang.c 2011-07-22 20:17:16.000000000 +0200 |
119 | +++ gdb-7.3.50.20110722/gdb/f-lang.c 2011-07-22 20:17:22.000000000 +0200 | |
120 | @@ -371,27 +371,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 | |
131 | -find_common_for_function (char *name, char *funcname) | |
132 | -{ | |
133 | - | |
134 | - SAVED_F77_COMMON_PTR tmp; | |
135 | - | |
136 | - tmp = head_common_list; | |
137 | - | |
138 | - while (tmp != NULL) | |
139 | - { | |
140 | - if (strcmp (tmp->name, name) == 0 | |
141 | - && strcmp (tmp->owning_function, funcname) == 0) | |
142 | - return (tmp); | |
143 | - else | |
144 | - tmp = tmp->next; | |
145 | - } | |
146 | - return (NULL); | |
147 | -} | |
f412e1b4 | 148 | Index: gdb-7.3.50.20110722/gdb/f-lang.h |
51a5ef0f | 149 | =================================================================== |
f412e1b4 PS |
150 | --- gdb-7.3.50.20110722.orig/gdb/f-lang.h 2011-07-22 20:17:16.000000000 +0200 |
151 | +++ gdb-7.3.50.20110722/gdb/f-lang.h 2011-07-22 20:17:22.000000000 +0200 | |
51a5ef0f PS |
152 | @@ -52,36 +52,8 @@ enum f90_range_type |
153 | NONE_BOUND_DEFAULT /* "(low:high)" */ | |
154 | }; | |
155 | ||
156 | -struct common_entry | |
157 | - { | |
158 | - struct symbol *symbol; /* The symbol node corresponding | |
159 | - to this component */ | |
160 | - struct common_entry *next; /* The next component */ | |
161 | - }; | |
162 | - | |
163 | -struct saved_f77_common | |
164 | - { | |
165 | - char *name; /* Name of COMMON */ | |
166 | - char *owning_function; /* Name of parent function */ | |
167 | - int secnum; /* Section # of .bss */ | |
168 | - CORE_ADDR offset; /* Offset from .bss for | |
169 | - this block */ | |
170 | - struct common_entry *entries; /* List of block's components */ | |
171 | - struct common_entry *end_of_entries; /* ptr. to end of components */ | |
172 | - struct saved_f77_common *next; /* Next saved COMMON block */ | |
173 | - }; | |
174 | - | |
175 | -typedef struct saved_f77_common SAVED_F77_COMMON, *SAVED_F77_COMMON_PTR; | |
176 | - | |
177 | -typedef struct common_entry COMMON_ENTRY, *COMMON_ENTRY_PTR; | |
178 | - | |
179 | -extern SAVED_F77_COMMON_PTR head_common_list; /* Ptr to 1st saved COMMON */ | |
180 | - | |
181 | -extern SAVED_F77_COMMON_PTR find_common_for_function (char *, char *); | |
182 | - | |
183 | #define BLANK_COMMON_NAME_ORIGINAL "#BLNK_COM" /* XLF assigned */ | |
184 | #define BLANK_COMMON_NAME_MF77 "__BLNK__" /* MF77 assigned */ | |
185 | -#define BLANK_COMMON_NAME_LOCAL "__BLANK" /* Local GDB */ | |
186 | ||
187 | /* When reasonable array bounds cannot be fetched, such as when | |
188 | you ask to 'mt print symbols' and there is no stack frame and | |
f412e1b4 | 189 | Index: gdb-7.3.50.20110722/gdb/f-valprint.c |
51a5ef0f | 190 | =================================================================== |
f412e1b4 PS |
191 | --- gdb-7.3.50.20110722.orig/gdb/f-valprint.c 2011-07-22 20:17:16.000000000 +0200 |
192 | +++ gdb-7.3.50.20110722/gdb/f-valprint.c 2011-07-22 20:18:26.000000000 +0200 | |
193 | @@ -34,10 +34,11 @@ | |
51a5ef0f PS |
194 | #include "gdbcore.h" |
195 | #include "command.h" | |
196 | #include "block.h" | |
197 | +#include "dictionary.h" | |
198 | +#include "gdb_assert.h" | |
199 | ||
200 | extern void _initialize_f_valprint (void); | |
201 | static void info_common_command (char *, int); | |
f412e1b4 PS |
202 | -static void list_all_visible_commons (char *); |
203 | static void f77_create_arrayprint_offset_tbl (struct type *, | |
204 | struct ui_file *); | |
205 | static void f77_get_dynamic_length_of_aggregate (struct type *); | |
206 | @@ -515,22 +516,54 @@ f_val_print (struct type *type, const gd | |
51a5ef0f PS |
207 | return 0; |
208 | } | |
209 | ||
210 | -static void | |
211 | -list_all_visible_commons (char *funname) | |
212 | +static int | |
213 | +info_common_command_for_block (struct block *block, struct frame_info *frame, | |
214 | + const char *comname) | |
215 | { | |
216 | - SAVED_F77_COMMON_PTR tmp; | |
217 | - | |
218 | - tmp = head_common_list; | |
219 | + struct dict_iterator iter; | |
220 | + struct symbol *sym; | |
221 | + int values_printed = 0; | |
222 | + const char *name; | |
223 | + struct value_print_options opts; | |
224 | + | |
225 | + get_user_print_options (&opts); | |
226 | + | |
227 | + ALL_BLOCK_SYMBOLS (block, iter, sym) | |
228 | + if (SYMBOL_DOMAIN (sym) == COMMON_BLOCK_DOMAIN) | |
229 | + { | |
230 | + struct type *type = SYMBOL_TYPE (sym); | |
231 | + int index; | |
232 | + | |
233 | + gdb_assert (SYMBOL_CLASS (sym) == LOC_STATIC); | |
234 | + gdb_assert (TYPE_CODE (type) == TYPE_CODE_STRUCT); | |
235 | + | |
236 | + if (comname && (!SYMBOL_LINKAGE_NAME (sym) | |
237 | + || strcmp (comname, SYMBOL_LINKAGE_NAME (sym)) != 0)) | |
238 | + continue; | |
239 | + | |
240 | + values_printed = 1; | |
241 | + if (SYMBOL_PRINT_NAME (sym)) | |
242 | + printf_filtered (_("Contents of F77 COMMON block '%s':\n"), | |
243 | + SYMBOL_PRINT_NAME (sym)); | |
244 | + else | |
245 | + printf_filtered (_("Contents of blank COMMON block:\n")); | |
246 | + | |
247 | + for (index = 0; index < TYPE_NFIELDS (type); index++) | |
248 | + { | |
249 | + struct value *val; | |
250 | + | |
251 | + gdb_assert (field_is_static (&TYPE_FIELD (type, index))); | |
252 | + val = value_static_field (type, index); | |
253 | + | |
254 | + printf_filtered ("%s = ", TYPE_FIELD_NAME (type, index)); | |
255 | + value_print (val, gdb_stdout, &opts); | |
256 | + putchar_filtered ('\n'); | |
257 | + } | |
258 | ||
259 | - printf_filtered (_("All COMMON blocks visible at this level:\n\n")); | |
260 | + putchar_filtered ('\n'); | |
261 | + } | |
262 | ||
263 | - while (tmp != NULL) | |
264 | - { | |
265 | - if (strcmp (tmp->owning_function, funname) == 0) | |
266 | - printf_filtered ("%s\n", tmp->name); | |
267 | - | |
268 | - tmp = tmp->next; | |
269 | - } | |
270 | + return values_printed; | |
271 | } | |
272 | ||
273 | /* This function is used to print out the values in a given COMMON | |
f412e1b4 | 274 | @@ -540,11 +573,9 @@ list_all_visible_commons (char *funname) |
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; | |
281 | - char *funname = 0; | |
282 | - struct symbol *func; | |
283 | + struct block *block; | |
284 | + int values_printed = 0; | |
285 | ||
286 | /* We have been told to display the contents of F77 COMMON | |
287 | block supposedly visible in this function. Let us | |
f412e1b4 | 288 | @@ -556,74 +587,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; | |
342 | + if (info_common_command_for_block (block, fi, comname)) | |
343 | + values_printed = 1; | |
344 | + /* After handling the function's top-level block, stop. Don't | |
345 | + continue to its superblock, the block of per-file symbols. */ | |
346 | + if (BLOCK_FUNCTION (block)) | |
347 | + break; | |
348 | + block = BLOCK_SUPERBLOCK (block); | |
349 | } | |
350 | ||
351 | - the_common = find_common_for_function (comname, funname); | |
352 | - | |
353 | - if (the_common) | |
354 | + if (!values_printed) | |
355 | { | |
356 | - if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0) | |
357 | - printf_filtered (_("Contents of blank COMMON block:\n")); | |
358 | + if (comname) | |
359 | + printf_filtered (_("No common block '%s'.\n"), comname); | |
360 | else | |
361 | - printf_filtered (_("Contents of F77 COMMON block '%s':\n"), comname); | |
362 | - | |
363 | - printf_filtered ("\n"); | |
364 | - entry = the_common->entries; | |
365 | - | |
366 | - while (entry != NULL) | |
367 | - { | |
368 | - print_variable_and_value (NULL, entry->symbol, fi, gdb_stdout, 0); | |
369 | - entry = entry->next; | |
370 | - } | |
371 | + printf_filtered (_("No common blocks.\n")); | |
372 | } | |
373 | - else | |
374 | - printf_filtered (_("Cannot locate the common block %s in function '%s'\n"), | |
375 | - comname, funname); | |
376 | } | |
377 | ||
378 | void | |
f412e1b4 | 379 | Index: gdb-7.3.50.20110722/gdb/stack.c |
51a5ef0f | 380 | =================================================================== |
f412e1b4 PS |
381 | --- gdb-7.3.50.20110722.orig/gdb/stack.c 2011-07-22 20:12:05.000000000 +0200 |
382 | +++ gdb-7.3.50.20110722/gdb/stack.c 2011-07-22 20:17:22.000000000 +0200 | |
383 | @@ -1524,6 +1524,8 @@ iterate_over_block_locals (struct block | |
51a5ef0f PS |
384 | case LOC_COMPUTED: |
385 | if (SYMBOL_IS_ARGUMENT (sym)) | |
386 | break; | |
387 | + if (SYMBOL_DOMAIN (sym) == COMMON_BLOCK_DOMAIN) | |
388 | + break; | |
389 | (*cb) (SYMBOL_PRINT_NAME (sym), sym, cb_data); | |
390 | break; | |
391 | ||
f412e1b4 | 392 | Index: gdb-7.3.50.20110722/gdb/symtab.h |
51a5ef0f | 393 | =================================================================== |
f412e1b4 PS |
394 | --- gdb-7.3.50.20110722.orig/gdb/symtab.h 2011-07-22 20:12:05.000000000 +0200 |
395 | +++ gdb-7.3.50.20110722/gdb/symtab.h 2011-07-22 20:18:58.000000000 +0200 | |
396 | @@ -396,7 +396,10 @@ typedef enum domain_enum_tag | |
51a5ef0f | 397 | |
f412e1b4 PS |
398 | /* LABEL_DOMAIN may be used for names of labels (for gotos). */ |
399 | ||
400 | - LABEL_DOMAIN | |
401 | + LABEL_DOMAIN, | |
51a5ef0f PS |
402 | + |
403 | + /* Fortran common blocks. Their naming must be separate from VAR_DOMAIN. */ | |
404 | + COMMON_BLOCK_DOMAIN | |
f412e1b4 | 405 | } domain_enum; |
51a5ef0f | 406 | |
f412e1b4 PS |
407 | /* Searching domains, used for `search_symbols'. Element numbers are |
408 | Index: gdb-7.3.50.20110722/gdb/testsuite/gdb.fortran/common-block.exp | |
51a5ef0f PS |
409 | =================================================================== |
410 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
f412e1b4 | 411 | +++ gdb-7.3.50.20110722/gdb/testsuite/gdb.fortran/common-block.exp 2011-07-22 20:17:22.000000000 +0200 |
51a5ef0f PS |
412 | @@ -0,0 +1,101 @@ |
413 | +# Copyright 2008 Free Software Foundation, Inc. | |
414 | + | |
415 | +# This program is free software; you can redistribute it and/or modify | |
416 | +# it under the terms of the GNU General Public License as published by | |
417 | +# the Free Software Foundation; either version 2 of the License, or | |
418 | +# (at your option) any later version. | |
419 | +# | |
420 | +# This program is distributed in the hope that it will be useful, | |
421 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
422 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
423 | +# GNU General Public License for more details. | |
424 | +# | |
425 | +# You should have received a copy of the GNU General Public License | |
426 | +# along with this program; if not, write to the Free Software | |
427 | +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
428 | + | |
429 | +# This file was written by Jan Kratochvil <jan.kratochvil@redhat.com>. | |
430 | + | |
431 | +set testfile "common-block" | |
432 | +set srcfile ${testfile}.f90 | |
433 | +set binfile ${objdir}/${subdir}/${testfile} | |
434 | + | |
f412e1b4 | 435 | +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f90 quiet}] != "" } { |
51a5ef0f PS |
436 | + untested "Couldn't compile ${srcfile}" |
437 | + return -1 | |
438 | +} | |
439 | + | |
440 | +gdb_exit | |
441 | +gdb_start | |
442 | +gdb_reinitialize_dir $srcdir/$subdir | |
443 | +gdb_load ${binfile} | |
444 | + | |
445 | +if ![runto MAIN__] then { | |
446 | + perror "couldn't run to breakpoint MAIN__" | |
447 | + continue | |
448 | +} | |
449 | + | |
450 | +gdb_breakpoint [gdb_get_line_number "stop-here-out"] | |
451 | +gdb_continue_to_breakpoint "stop-here-out" | |
452 | + | |
453 | +# Common block naming with source name /foo/: | |
454 | +# .symtab DW_TAG_common_block's DW_AT_name | |
455 | +# Intel Fortran foo_ foo_ | |
456 | +# GNU Fortran foo_ foo | |
457 | +#set suffix "_" | |
458 | +set suffix "" | |
459 | + | |
460 | +set int4 {(integer\(kind=4\)|INTEGER\(4\))} | |
461 | +set real4 {(real\(kind=4\)|REAL\(4\))} | |
462 | +set real8 {(real\(kind=8\)|REAL\(8\))} | |
463 | + | |
464 | +gdb_test "whatis foo$suffix" "No symbol \"foo$suffix\" in current context." | |
465 | +gdb_test "ptype foo$suffix" "No symbol \"foo$suffix\" in current context." | |
466 | +gdb_test "p foo$suffix" "No symbol \"foo$suffix\" in current context." | |
467 | +gdb_test "whatis fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." | |
468 | +gdb_test "ptype fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." | |
469 | +gdb_test "p fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." | |
470 | + | |
471 | +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" | |
472 | +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" | |
473 | + | |
474 | +gdb_test "ptype ix" "type = $int4" "ptype ix out" | |
475 | +gdb_test "ptype iy" "type = $real4" "ptype iy out" | |
476 | +gdb_test "ptype iz" "type = $real8" "ptype iz out" | |
477 | +gdb_test "ptype ix_x" "type = $int4" "ptype ix_x out" | |
478 | +gdb_test "ptype iy_y" "type = $real4" "ptype iy_y out" | |
479 | +gdb_test "ptype iz_z" "type = $real8" "ptype iz_z out" | |
480 | + | |
481 | +gdb_test "p ix" " = 1 *" "p ix out" | |
482 | +gdb_test "p iy" " = 2 *" "p iy out" | |
483 | +gdb_test "p iz" " = 3 *" "p iz out" | |
484 | +gdb_test "p ix_x" " = 11 *" "p ix_x out" | |
485 | +gdb_test "p iy_y" " = 22 *" "p iy_y out" | |
486 | +gdb_test "p iz_z" " = 33 *" "p iz_z out" | |
487 | + | |
488 | +gdb_breakpoint [gdb_get_line_number "stop-here-in"] | |
489 | +gdb_continue_to_breakpoint "stop-here-in" | |
490 | + | |
491 | +gdb_test "whatis foo$suffix" "No symbol \"foo$suffix\" in current context." "whatis foo$suffix in" | |
492 | +gdb_test "ptype foo$suffix" "No symbol \"foo$suffix\" in current context." "ptype foo$suffix in" | |
493 | +gdb_test "p foo$suffix" "No symbol \"foo$suffix\" in current context." "p foo$suffix in" | |
494 | +gdb_test "whatis fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "whatis fo_o$suffix in" | |
495 | +gdb_test "ptype fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "ptype fo_o$suffix in" | |
496 | +gdb_test "p fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "p fo_o$suffix in" | |
497 | + | |
498 | +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" | |
499 | +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" | |
500 | + | |
501 | +gdb_test "ptype ix" "type = $int4" "ptype ix in" | |
502 | +gdb_test "ptype iy2" "type = $real4" "ptype iy2 in" | |
503 | +gdb_test "ptype iz" "type = $real8" "ptype iz in" | |
504 | +gdb_test "ptype ix_x" "type = $int4" "ptype ix_x in" | |
505 | +gdb_test "ptype iy_y" "type = $real4" "ptype iy_y in" | |
506 | +gdb_test "ptype iz_z2" "type = $real8" "ptype iz_z2 in" | |
507 | + | |
508 | +gdb_test "p ix" " = 11 *" "p ix in" | |
509 | +gdb_test "p iy2" " = 22 *" "p iy2 in" | |
510 | +gdb_test "p iz" " = 33 *" "p iz in" | |
511 | +gdb_test "p ix_x" " = 1 *" "p ix_x in" | |
512 | +gdb_test "p iy_y" " = 2 *" "p iy_y in" | |
513 | +gdb_test "p iz_z2" " = 3 *" "p iz_z2 in" | |
f412e1b4 | 514 | Index: gdb-7.3.50.20110722/gdb/testsuite/gdb.fortran/common-block.f90 |
51a5ef0f PS |
515 | =================================================================== |
516 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
f412e1b4 | 517 | +++ gdb-7.3.50.20110722/gdb/testsuite/gdb.fortran/common-block.f90 2011-07-22 20:17:22.000000000 +0200 |
51a5ef0f PS |
518 | @@ -0,0 +1,67 @@ |
519 | +! Copyright 2008 Free Software Foundation, Inc. | |
520 | +! | |
521 | +! This program is free software; you can redistribute it and/or modify | |
522 | +! it under the terms of the GNU General Public License as published by | |
523 | +! the Free Software Foundation; either version 2 of the License, or | |
524 | +! (at your option) any later version. | |
525 | +! | |
526 | +! This program is distributed in the hope that it will be useful, | |
527 | +! but WITHOUT ANY WARRANTY; without even the implied warranty of | |
528 | +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
529 | +! GNU General Public License for more details. | |
530 | +! | |
531 | +! You should have received a copy of the GNU General Public License | |
532 | +! along with this program; if not, write to the Free Software | |
533 | +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
534 | +! | |
535 | +! Ihis file is the Fortran source file for dynamic.exp. | |
536 | +! Original file written by Jakub Jelinek <jakub@redhat.com>. | |
537 | +! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@redhat.com>. | |
538 | + | |
539 | +subroutine in | |
540 | + | |
541 | + INTEGER*4 ix | |
542 | + REAL*4 iy2 | |
543 | + REAL*8 iz | |
544 | + | |
545 | + INTEGER*4 ix_x | |
546 | + REAL*4 iy_y | |
547 | + REAL*8 iz_z2 | |
548 | + | |
549 | + common /fo_o/ix,iy2,iz | |
550 | + common /foo/ix_x,iy_y,iz_z2 | |
551 | + | |
552 | + iy = 5 | |
553 | + iz_z = 55 | |
554 | + | |
555 | + if (ix .ne. 11 .or. iy2 .ne. 22.0 .or. iz .ne. 33.0) call abort | |
556 | + if (ix_x .ne. 1 .or. iy_y .ne. 2.0 .or. iz_z2 .ne. 3.0) call abort | |
557 | + | |
558 | + ix = 0 ! stop-here-in | |
559 | + | |
560 | +end subroutine in | |
561 | + | |
562 | +program common_test | |
563 | + | |
564 | + INTEGER*4 ix | |
565 | + REAL*4 iy | |
566 | + REAL*8 iz | |
567 | + | |
568 | + INTEGER*4 ix_x | |
569 | + REAL*4 iy_y | |
570 | + REAL*8 iz_z | |
571 | + | |
572 | + common /foo/ix,iy,iz | |
573 | + common /fo_o/ix_x,iy_y,iz_z | |
574 | + | |
575 | + ix = 1 | |
576 | + iy = 2.0 | |
577 | + iz = 3.0 | |
578 | + | |
579 | + ix_x = 11 | |
580 | + iy_y = 22.0 | |
581 | + iz_z = 33.0 | |
582 | + | |
583 | + call in ! stop-here-out | |
584 | + | |
585 | +end program common_test |