]>
Commit | Line | Data |
---|---|---|
51a5ef0f PS |
1 | Index: gdb-7.1.90.20100711/gdb/dwarf2read.c |
2 | =================================================================== | |
3 | --- gdb-7.1.90.20100711.orig/gdb/dwarf2read.c 2010-07-13 00:13:02.000000000 +0200 | |
4 | +++ gdb-7.1.90.20100711/gdb/dwarf2read.c 2010-07-13 00:26:25.000000000 +0200 | |
5 | @@ -5727,12 +5727,14 @@ read_set_type (struct die_info *die, str | |
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; | |
22 | @@ -5757,10 +5759,40 @@ read_common_block (struct die_info *die, | |
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 | { | |
55 | + /* Create the symbol in the DW_TAG_common_block block in the current | |
56 | + symbol scope. */ | |
57 | sym = new_symbol (child_die, NULL, cu); | |
58 | + | |
59 | + /* Undocumented in DWARF3, when it can be present? */ | |
60 | attr = dwarf2_attr (child_die, DW_AT_data_member_location, cu); | |
61 | if (attr) | |
62 | { | |
63 | @@ -5778,8 +5810,25 @@ read_common_block (struct die_info *die, | |
64 | SYMBOL_VALUE_ADDRESS (sym) = base + byte_offset; | |
65 | add_symbol_to_list (sym, &global_symbols); | |
66 | } | |
67 | + | |
68 | + if (SYMBOL_CLASS (sym) == LOC_STATIC) | |
69 | + SET_FIELD_PHYSADDR (*field, SYMBOL_VALUE_ADDRESS (sym)); | |
70 | + else | |
71 | + SET_FIELD_PHYSNAME (*field, SYMBOL_LINKAGE_NAME (sym)); | |
72 | + FIELD_TYPE (*field) = SYMBOL_TYPE (sym); | |
73 | + FIELD_NAME (*field) = SYMBOL_NATURAL_NAME (sym); | |
74 | + field++; | |
75 | child_die = sibling_die (child_die); | |
76 | } | |
77 | + | |
78 | + /* TYPE_LENGTH (type) is left 0 - it is only a virtual structure even | |
79 | + with no consecutive address space. */ | |
80 | + | |
81 | + sym = new_symbol (die, type, cu); | |
82 | + /* SYMBOL_VALUE_ADDRESS never gets used as all its fields are static. */ | |
83 | + SYMBOL_VALUE_ADDRESS (sym) = base; | |
84 | + | |
85 | + set_die_type (die, type, cu); | |
86 | } | |
87 | } | |
88 | ||
89 | @@ -9106,6 +9155,13 @@ new_symbol (struct die_info *die, struct | |
90 | { | |
91 | var_decode_location (attr, sym, cu); | |
92 | attr2 = dwarf2_attr (die, DW_AT_external, cu); | |
93 | + | |
94 | + /* Fortran explicitly imports any global symbols to the local | |
95 | + scope by DW_TAG_common_block. */ | |
96 | + if (cu->language == language_fortran && die->parent | |
97 | + && die->parent->tag == DW_TAG_common_block) | |
98 | + attr2 = NULL; | |
99 | + | |
100 | if (attr2 && (DW_UNSND (attr2) != 0)) | |
101 | { | |
102 | struct pending **list_to_add; | |
103 | @@ -9277,6 +9333,11 @@ new_symbol (struct die_info *die, struct | |
104 | SYMBOL_CLASS (sym) = LOC_TYPEDEF; | |
105 | add_symbol_to_list (sym, &global_symbols); | |
106 | break; | |
107 | + case DW_TAG_common_block: | |
108 | + SYMBOL_CLASS (sym) = LOC_STATIC; | |
109 | + SYMBOL_DOMAIN (sym) = COMMON_BLOCK_DOMAIN; | |
110 | + add_symbol_to_list (sym, cu->list_in_scope); | |
111 | + break; | |
112 | default: | |
113 | /* Not a tag we recognize. Hopefully we aren't processing | |
114 | trash data, but since we must specifically ignore things | |
115 | Index: gdb-7.1.90.20100711/gdb/f-lang.c | |
116 | =================================================================== | |
117 | --- gdb-7.1.90.20100711.orig/gdb/f-lang.c 2010-07-13 00:24:04.000000000 +0200 | |
118 | +++ gdb-7.1.90.20100711/gdb/f-lang.c 2010-07-13 00:25:56.000000000 +0200 | |
119 | @@ -443,27 +443,3 @@ _initialize_f_language (void) | |
120 | ||
121 | add_language (&f_language_defn); | |
122 | } | |
123 | - | |
124 | -SAVED_F77_COMMON_PTR head_common_list = NULL; /* Ptr to 1st saved COMMON */ | |
125 | - | |
126 | -/* This routine finds the first encountred COMMON block named "name" | |
127 | - that belongs to function funcname */ | |
128 | - | |
129 | -SAVED_F77_COMMON_PTR | |
130 | -find_common_for_function (char *name, char *funcname) | |
131 | -{ | |
132 | - | |
133 | - SAVED_F77_COMMON_PTR tmp; | |
134 | - | |
135 | - tmp = head_common_list; | |
136 | - | |
137 | - while (tmp != NULL) | |
138 | - { | |
139 | - if (strcmp (tmp->name, name) == 0 | |
140 | - && strcmp (tmp->owning_function, funcname) == 0) | |
141 | - return (tmp); | |
142 | - else | |
143 | - tmp = tmp->next; | |
144 | - } | |
145 | - return (NULL); | |
146 | -} | |
147 | Index: gdb-7.1.90.20100711/gdb/f-lang.h | |
148 | =================================================================== | |
149 | --- gdb-7.1.90.20100711.orig/gdb/f-lang.h 2010-07-13 00:24:04.000000000 +0200 | |
150 | +++ gdb-7.1.90.20100711/gdb/f-lang.h 2010-07-13 00:25:56.000000000 +0200 | |
151 | @@ -52,36 +52,8 @@ enum f90_range_type | |
152 | NONE_BOUND_DEFAULT /* "(low:high)" */ | |
153 | }; | |
154 | ||
155 | -struct common_entry | |
156 | - { | |
157 | - struct symbol *symbol; /* The symbol node corresponding | |
158 | - to this component */ | |
159 | - struct common_entry *next; /* The next component */ | |
160 | - }; | |
161 | - | |
162 | -struct saved_f77_common | |
163 | - { | |
164 | - char *name; /* Name of COMMON */ | |
165 | - char *owning_function; /* Name of parent function */ | |
166 | - int secnum; /* Section # of .bss */ | |
167 | - CORE_ADDR offset; /* Offset from .bss for | |
168 | - this block */ | |
169 | - struct common_entry *entries; /* List of block's components */ | |
170 | - struct common_entry *end_of_entries; /* ptr. to end of components */ | |
171 | - struct saved_f77_common *next; /* Next saved COMMON block */ | |
172 | - }; | |
173 | - | |
174 | -typedef struct saved_f77_common SAVED_F77_COMMON, *SAVED_F77_COMMON_PTR; | |
175 | - | |
176 | -typedef struct common_entry COMMON_ENTRY, *COMMON_ENTRY_PTR; | |
177 | - | |
178 | -extern SAVED_F77_COMMON_PTR head_common_list; /* Ptr to 1st saved COMMON */ | |
179 | - | |
180 | -extern SAVED_F77_COMMON_PTR find_common_for_function (char *, char *); | |
181 | - | |
182 | #define BLANK_COMMON_NAME_ORIGINAL "#BLNK_COM" /* XLF assigned */ | |
183 | #define BLANK_COMMON_NAME_MF77 "__BLNK__" /* MF77 assigned */ | |
184 | -#define BLANK_COMMON_NAME_LOCAL "__BLANK" /* Local GDB */ | |
185 | ||
186 | /* When reasonable array bounds cannot be fetched, such as when | |
187 | you ask to 'mt print symbols' and there is no stack frame and | |
188 | Index: gdb-7.1.90.20100711/gdb/f-valprint.c | |
189 | =================================================================== | |
190 | --- gdb-7.1.90.20100711.orig/gdb/f-valprint.c 2010-07-13 00:24:25.000000000 +0200 | |
191 | +++ gdb-7.1.90.20100711/gdb/f-valprint.c 2010-07-13 00:32:05.000000000 +0200 | |
192 | @@ -34,6 +34,8 @@ | |
193 | #include "gdbcore.h" | |
194 | #include "command.h" | |
195 | #include "block.h" | |
196 | +#include "dictionary.h" | |
197 | +#include "gdb_assert.h" | |
198 | ||
199 | extern void _initialize_f_valprint (void); | |
200 | static void info_common_command (char *, int); | |
201 | @@ -486,22 +488,54 @@ f_val_print (struct type *type, const gd | |
202 | return 0; | |
203 | } | |
204 | ||
205 | -static void | |
206 | -list_all_visible_commons (char *funname) | |
207 | +static int | |
208 | +info_common_command_for_block (struct block *block, struct frame_info *frame, | |
209 | + const char *comname) | |
210 | { | |
211 | - SAVED_F77_COMMON_PTR tmp; | |
212 | - | |
213 | - tmp = head_common_list; | |
214 | + struct dict_iterator iter; | |
215 | + struct symbol *sym; | |
216 | + int values_printed = 0; | |
217 | + const char *name; | |
218 | + struct value_print_options opts; | |
219 | + | |
220 | + get_user_print_options (&opts); | |
221 | + | |
222 | + ALL_BLOCK_SYMBOLS (block, iter, sym) | |
223 | + if (SYMBOL_DOMAIN (sym) == COMMON_BLOCK_DOMAIN) | |
224 | + { | |
225 | + struct type *type = SYMBOL_TYPE (sym); | |
226 | + int index; | |
227 | + | |
228 | + gdb_assert (SYMBOL_CLASS (sym) == LOC_STATIC); | |
229 | + gdb_assert (TYPE_CODE (type) == TYPE_CODE_STRUCT); | |
230 | + | |
231 | + if (comname && (!SYMBOL_LINKAGE_NAME (sym) | |
232 | + || strcmp (comname, SYMBOL_LINKAGE_NAME (sym)) != 0)) | |
233 | + continue; | |
234 | + | |
235 | + values_printed = 1; | |
236 | + if (SYMBOL_PRINT_NAME (sym)) | |
237 | + printf_filtered (_("Contents of F77 COMMON block '%s':\n"), | |
238 | + SYMBOL_PRINT_NAME (sym)); | |
239 | + else | |
240 | + printf_filtered (_("Contents of blank COMMON block:\n")); | |
241 | + | |
242 | + for (index = 0; index < TYPE_NFIELDS (type); index++) | |
243 | + { | |
244 | + struct value *val; | |
245 | + | |
246 | + gdb_assert (field_is_static (&TYPE_FIELD (type, index))); | |
247 | + val = value_static_field (type, index); | |
248 | + | |
249 | + printf_filtered ("%s = ", TYPE_FIELD_NAME (type, index)); | |
250 | + value_print (val, gdb_stdout, &opts); | |
251 | + putchar_filtered ('\n'); | |
252 | + } | |
253 | ||
254 | - printf_filtered (_("All COMMON blocks visible at this level:\n\n")); | |
255 | + putchar_filtered ('\n'); | |
256 | + } | |
257 | ||
258 | - while (tmp != NULL) | |
259 | - { | |
260 | - if (strcmp (tmp->owning_function, funname) == 0) | |
261 | - printf_filtered ("%s\n", tmp->name); | |
262 | - | |
263 | - tmp = tmp->next; | |
264 | - } | |
265 | + return values_printed; | |
266 | } | |
267 | ||
268 | /* This function is used to print out the values in a given COMMON | |
269 | @@ -511,11 +545,9 @@ list_all_visible_commons (char *funname) | |
270 | static void | |
271 | info_common_command (char *comname, int from_tty) | |
272 | { | |
273 | - SAVED_F77_COMMON_PTR the_common; | |
274 | - COMMON_ENTRY_PTR entry; | |
275 | struct frame_info *fi; | |
276 | - char *funname = 0; | |
277 | - struct symbol *func; | |
278 | + struct block *block; | |
279 | + int values_printed = 0; | |
280 | ||
281 | /* We have been told to display the contents of F77 COMMON | |
282 | block supposedly visible in this function. Let us | |
283 | @@ -527,74 +559,31 @@ info_common_command (char *comname, int | |
284 | /* The following is generally ripped off from stack.c's routine | |
285 | print_frame_info() */ | |
286 | ||
287 | - func = find_pc_function (get_frame_pc (fi)); | |
288 | - if (func) | |
289 | + block = get_frame_block (fi, 0); | |
290 | + if (block == NULL) | |
291 | { | |
292 | - /* In certain pathological cases, the symtabs give the wrong | |
293 | - function (when we are in the first function in a file which | |
294 | - is compiled without debugging symbols, the previous function | |
295 | - is compiled with debugging symbols, and the "foo.o" symbol | |
296 | - that is supposed to tell us where the file with debugging symbols | |
297 | - ends has been truncated by ar because it is longer than 15 | |
298 | - characters). | |
299 | - | |
300 | - So look in the minimal symbol tables as well, and if it comes | |
301 | - up with a larger address for the function use that instead. | |
302 | - I don't think this can ever cause any problems; there shouldn't | |
303 | - be any minimal symbols in the middle of a function. | |
304 | - FIXME: (Not necessarily true. What about text labels) */ | |
305 | - | |
306 | - struct minimal_symbol *msymbol = | |
307 | - lookup_minimal_symbol_by_pc (get_frame_pc (fi)); | |
308 | - | |
309 | - if (msymbol != NULL | |
310 | - && (SYMBOL_VALUE_ADDRESS (msymbol) | |
311 | - > BLOCK_START (SYMBOL_BLOCK_VALUE (func)))) | |
312 | - funname = SYMBOL_LINKAGE_NAME (msymbol); | |
313 | - else | |
314 | - funname = SYMBOL_LINKAGE_NAME (func); | |
315 | - } | |
316 | - else | |
317 | - { | |
318 | - struct minimal_symbol *msymbol = | |
319 | - lookup_minimal_symbol_by_pc (get_frame_pc (fi)); | |
320 | - | |
321 | - if (msymbol != NULL) | |
322 | - funname = SYMBOL_LINKAGE_NAME (msymbol); | |
323 | - else /* Got no 'funname', code below will fail. */ | |
324 | - error (_("No function found for frame.")); | |
325 | + printf_filtered (_("No symbol table info available.\n")); | |
326 | + return; | |
327 | } | |
328 | ||
329 | - /* If comname is NULL, we assume the user wishes to see the | |
330 | - which COMMON blocks are visible here and then return */ | |
331 | - | |
332 | - if (comname == 0) | |
333 | + while (block) | |
334 | { | |
335 | - list_all_visible_commons (funname); | |
336 | - return; | |
337 | + if (info_common_command_for_block (block, fi, comname)) | |
338 | + values_printed = 1; | |
339 | + /* After handling the function's top-level block, stop. Don't | |
340 | + continue to its superblock, the block of per-file symbols. */ | |
341 | + if (BLOCK_FUNCTION (block)) | |
342 | + break; | |
343 | + block = BLOCK_SUPERBLOCK (block); | |
344 | } | |
345 | ||
346 | - the_common = find_common_for_function (comname, funname); | |
347 | - | |
348 | - if (the_common) | |
349 | + if (!values_printed) | |
350 | { | |
351 | - if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0) | |
352 | - printf_filtered (_("Contents of blank COMMON block:\n")); | |
353 | + if (comname) | |
354 | + printf_filtered (_("No common block '%s'.\n"), comname); | |
355 | else | |
356 | - printf_filtered (_("Contents of F77 COMMON block '%s':\n"), comname); | |
357 | - | |
358 | - printf_filtered ("\n"); | |
359 | - entry = the_common->entries; | |
360 | - | |
361 | - while (entry != NULL) | |
362 | - { | |
363 | - print_variable_and_value (NULL, entry->symbol, fi, gdb_stdout, 0); | |
364 | - entry = entry->next; | |
365 | - } | |
366 | + printf_filtered (_("No common blocks.\n")); | |
367 | } | |
368 | - else | |
369 | - printf_filtered (_("Cannot locate the common block %s in function '%s'\n"), | |
370 | - comname, funname); | |
371 | } | |
372 | ||
373 | void | |
374 | Index: gdb-7.1.90.20100711/gdb/stack.c | |
375 | =================================================================== | |
376 | --- gdb-7.1.90.20100711.orig/gdb/stack.c 2010-07-01 17:36:17.000000000 +0200 | |
377 | +++ gdb-7.1.90.20100711/gdb/stack.c 2010-07-13 00:29:49.000000000 +0200 | |
378 | @@ -1484,6 +1484,8 @@ iterate_over_block_locals (struct block | |
379 | case LOC_COMPUTED: | |
380 | if (SYMBOL_IS_ARGUMENT (sym)) | |
381 | break; | |
382 | + if (SYMBOL_DOMAIN (sym) == COMMON_BLOCK_DOMAIN) | |
383 | + break; | |
384 | (*cb) (SYMBOL_PRINT_NAME (sym), sym, cb_data); | |
385 | break; | |
386 | ||
387 | Index: gdb-7.1.90.20100711/gdb/symtab.h | |
388 | =================================================================== | |
389 | --- gdb-7.1.90.20100711.orig/gdb/symtab.h 2010-07-12 23:07:33.000000000 +0200 | |
390 | +++ gdb-7.1.90.20100711/gdb/symtab.h 2010-07-13 00:27:02.000000000 +0200 | |
391 | @@ -396,7 +396,10 @@ typedef enum domain_enum_tag | |
392 | FUNCTIONS_DOMAIN, | |
393 | ||
394 | /* All defined types */ | |
395 | - TYPES_DOMAIN | |
396 | + TYPES_DOMAIN, | |
397 | + | |
398 | + /* Fortran common blocks. Their naming must be separate from VAR_DOMAIN. */ | |
399 | + COMMON_BLOCK_DOMAIN | |
400 | } | |
401 | domain_enum; | |
402 | ||
403 | Index: gdb-7.1.90.20100711/gdb/testsuite/gdb.fortran/common-block.exp | |
404 | =================================================================== | |
405 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
406 | +++ gdb-7.1.90.20100711/gdb/testsuite/gdb.fortran/common-block.exp 2010-07-13 00:25:56.000000000 +0200 | |
407 | @@ -0,0 +1,101 @@ | |
408 | +# Copyright 2008 Free Software Foundation, Inc. | |
409 | + | |
410 | +# This program is free software; you can redistribute it and/or modify | |
411 | +# it under the terms of the GNU General Public License as published by | |
412 | +# the Free Software Foundation; either version 2 of the License, or | |
413 | +# (at your option) any later version. | |
414 | +# | |
415 | +# This program is distributed in the hope that it will be useful, | |
416 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
417 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
418 | +# GNU General Public License for more details. | |
419 | +# | |
420 | +# You should have received a copy of the GNU General Public License | |
421 | +# along with this program; if not, write to the Free Software | |
422 | +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
423 | + | |
424 | +# This file was written by Jan Kratochvil <jan.kratochvil@redhat.com>. | |
425 | + | |
426 | +set testfile "common-block" | |
427 | +set srcfile ${testfile}.f90 | |
428 | +set binfile ${objdir}/${subdir}/${testfile} | |
429 | + | |
430 | +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f77 quiet}] != "" } { | |
431 | + untested "Couldn't compile ${srcfile}" | |
432 | + return -1 | |
433 | +} | |
434 | + | |
435 | +gdb_exit | |
436 | +gdb_start | |
437 | +gdb_reinitialize_dir $srcdir/$subdir | |
438 | +gdb_load ${binfile} | |
439 | + | |
440 | +if ![runto MAIN__] then { | |
441 | + perror "couldn't run to breakpoint MAIN__" | |
442 | + continue | |
443 | +} | |
444 | + | |
445 | +gdb_breakpoint [gdb_get_line_number "stop-here-out"] | |
446 | +gdb_continue_to_breakpoint "stop-here-out" | |
447 | + | |
448 | +# Common block naming with source name /foo/: | |
449 | +# .symtab DW_TAG_common_block's DW_AT_name | |
450 | +# Intel Fortran foo_ foo_ | |
451 | +# GNU Fortran foo_ foo | |
452 | +#set suffix "_" | |
453 | +set suffix "" | |
454 | + | |
455 | +set int4 {(integer\(kind=4\)|INTEGER\(4\))} | |
456 | +set real4 {(real\(kind=4\)|REAL\(4\))} | |
457 | +set real8 {(real\(kind=8\)|REAL\(8\))} | |
458 | + | |
459 | +gdb_test "whatis foo$suffix" "No symbol \"foo$suffix\" in current context." | |
460 | +gdb_test "ptype foo$suffix" "No symbol \"foo$suffix\" in current context." | |
461 | +gdb_test "p foo$suffix" "No symbol \"foo$suffix\" in current context." | |
462 | +gdb_test "whatis fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." | |
463 | +gdb_test "ptype fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." | |
464 | +gdb_test "p fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." | |
465 | + | |
466 | +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" | |
467 | +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" | |
468 | + | |
469 | +gdb_test "ptype ix" "type = $int4" "ptype ix out" | |
470 | +gdb_test "ptype iy" "type = $real4" "ptype iy out" | |
471 | +gdb_test "ptype iz" "type = $real8" "ptype iz out" | |
472 | +gdb_test "ptype ix_x" "type = $int4" "ptype ix_x out" | |
473 | +gdb_test "ptype iy_y" "type = $real4" "ptype iy_y out" | |
474 | +gdb_test "ptype iz_z" "type = $real8" "ptype iz_z out" | |
475 | + | |
476 | +gdb_test "p ix" " = 1 *" "p ix out" | |
477 | +gdb_test "p iy" " = 2 *" "p iy out" | |
478 | +gdb_test "p iz" " = 3 *" "p iz out" | |
479 | +gdb_test "p ix_x" " = 11 *" "p ix_x out" | |
480 | +gdb_test "p iy_y" " = 22 *" "p iy_y out" | |
481 | +gdb_test "p iz_z" " = 33 *" "p iz_z out" | |
482 | + | |
483 | +gdb_breakpoint [gdb_get_line_number "stop-here-in"] | |
484 | +gdb_continue_to_breakpoint "stop-here-in" | |
485 | + | |
486 | +gdb_test "whatis foo$suffix" "No symbol \"foo$suffix\" in current context." "whatis foo$suffix in" | |
487 | +gdb_test "ptype foo$suffix" "No symbol \"foo$suffix\" in current context." "ptype foo$suffix in" | |
488 | +gdb_test "p foo$suffix" "No symbol \"foo$suffix\" in current context." "p foo$suffix in" | |
489 | +gdb_test "whatis fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "whatis fo_o$suffix in" | |
490 | +gdb_test "ptype fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "ptype fo_o$suffix in" | |
491 | +gdb_test "p fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "p fo_o$suffix in" | |
492 | + | |
493 | +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" | |
494 | +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" | |
495 | + | |
496 | +gdb_test "ptype ix" "type = $int4" "ptype ix in" | |
497 | +gdb_test "ptype iy2" "type = $real4" "ptype iy2 in" | |
498 | +gdb_test "ptype iz" "type = $real8" "ptype iz in" | |
499 | +gdb_test "ptype ix_x" "type = $int4" "ptype ix_x in" | |
500 | +gdb_test "ptype iy_y" "type = $real4" "ptype iy_y in" | |
501 | +gdb_test "ptype iz_z2" "type = $real8" "ptype iz_z2 in" | |
502 | + | |
503 | +gdb_test "p ix" " = 11 *" "p ix in" | |
504 | +gdb_test "p iy2" " = 22 *" "p iy2 in" | |
505 | +gdb_test "p iz" " = 33 *" "p iz in" | |
506 | +gdb_test "p ix_x" " = 1 *" "p ix_x in" | |
507 | +gdb_test "p iy_y" " = 2 *" "p iy_y in" | |
508 | +gdb_test "p iz_z2" " = 3 *" "p iz_z2 in" | |
509 | Index: gdb-7.1.90.20100711/gdb/testsuite/gdb.fortran/common-block.f90 | |
510 | =================================================================== | |
511 | --- /dev/null 1970-01-01 00:00:00.000000000 +0000 | |
512 | +++ gdb-7.1.90.20100711/gdb/testsuite/gdb.fortran/common-block.f90 2010-07-13 00:25:56.000000000 +0200 | |
513 | @@ -0,0 +1,67 @@ | |
514 | +! Copyright 2008 Free Software Foundation, Inc. | |
515 | +! | |
516 | +! This program is free software; you can redistribute it and/or modify | |
517 | +! it under the terms of the GNU General Public License as published by | |
518 | +! the Free Software Foundation; either version 2 of the License, or | |
519 | +! (at your option) any later version. | |
520 | +! | |
521 | +! This program is distributed in the hope that it will be useful, | |
522 | +! but WITHOUT ANY WARRANTY; without even the implied warranty of | |
523 | +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
524 | +! GNU General Public License for more details. | |
525 | +! | |
526 | +! You should have received a copy of the GNU General Public License | |
527 | +! along with this program; if not, write to the Free Software | |
528 | +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
529 | +! | |
530 | +! Ihis file is the Fortran source file for dynamic.exp. | |
531 | +! Original file written by Jakub Jelinek <jakub@redhat.com>. | |
532 | +! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@redhat.com>. | |
533 | + | |
534 | +subroutine in | |
535 | + | |
536 | + INTEGER*4 ix | |
537 | + REAL*4 iy2 | |
538 | + REAL*8 iz | |
539 | + | |
540 | + INTEGER*4 ix_x | |
541 | + REAL*4 iy_y | |
542 | + REAL*8 iz_z2 | |
543 | + | |
544 | + common /fo_o/ix,iy2,iz | |
545 | + common /foo/ix_x,iy_y,iz_z2 | |
546 | + | |
547 | + iy = 5 | |
548 | + iz_z = 55 | |
549 | + | |
550 | + if (ix .ne. 11 .or. iy2 .ne. 22.0 .or. iz .ne. 33.0) call abort | |
551 | + if (ix_x .ne. 1 .or. iy_y .ne. 2.0 .or. iz_z2 .ne. 3.0) call abort | |
552 | + | |
553 | + ix = 0 ! stop-here-in | |
554 | + | |
555 | +end subroutine in | |
556 | + | |
557 | +program common_test | |
558 | + | |
559 | + INTEGER*4 ix | |
560 | + REAL*4 iy | |
561 | + REAL*8 iz | |
562 | + | |
563 | + INTEGER*4 ix_x | |
564 | + REAL*4 iy_y | |
565 | + REAL*8 iz_z | |
566 | + | |
567 | + common /foo/ix,iy,iz | |
568 | + common /fo_o/ix_x,iy_y,iz_z | |
569 | + | |
570 | + ix = 1 | |
571 | + iy = 2.0 | |
572 | + iz = 3.0 | |
573 | + | |
574 | + ix_x = 11 | |
575 | + iy_y = 22.0 | |
576 | + iz_z = 33.0 | |
577 | + | |
578 | + call in ! stop-here-out | |
579 | + | |
580 | +end program common_test |