* [gfortran] Patch: Fix PR 13415
@ 2004-07-09 21:09 Tobias Schlüter
2004-07-10 7:08 ` Paul Brook
0 siblings, 1 reply; 3+ messages in thread
From: Tobias Schlüter @ 2004-07-09 21:09 UTC (permalink / raw)
To: GCC Fortran mailing list, patch
PR 13415 was a problem with array pointers in common blocks: we failed
when trying to calculate the array size, when in fact we should have
been storing the array descriptor.
Built and tested on i686-pc-linux. Since the original code had some
reminiscences of its origin in g95, there are whitespace changes in the
patch, I also changed the variable names to something more expressive.
trans-common.c is in fact full of trailing whitespace, which I will
remove in a follow-up patch, and, if people agree, I will change some
variable names to something more expressive also in other functions.
Since I won't be intermingling those changes with functional changes
those changes shouldn't hurt.
Anyway, patch below. I will also add a testcase to the testsuite.
- Tobi
204-07-09 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/13415
* trans-common.c (calculate_length): Correctly handle arrays
whose descriptor ends up in the common block.
Index: trans-common.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-common.c,v
retrieving revision 1.9
diff -c -3 -p -r1.9 trans-common.c
*** trans-common.c 29 Jun 2004 22:11:38 -0000 1.9
--- trans-common.c 9 Jul 2004 19:42:17 -0000
*************** find_segment_info (gfc_symbol *symbol)
*** 457,479 ****
static HOST_WIDE_INT
calculate_length (gfc_symbol *symbol)
! {
! HOST_WIDE_INT j, element_size;
! mpz_t elements;
if (symbol->ts.type == BT_CHARACTER)
gfc_conv_const_charlen (symbol->ts.cl);
element_size = int_size_in_bytes (gfc_typenode_for_spec (&symbol->ts));
- if (symbol->as == NULL)
- return element_size;
! /* Calculate the number of elements in the array */
! if (spec_size (symbol->as, &elements) == FAILURE)
gfc_internal_error ("calculate_length(): Unable to determine array
size");
! j = mpz_get_ui (elements);
! mpz_clear (elements);
! return j*element_size;;
}
--- 457,482 ----
static HOST_WIDE_INT
calculate_length (gfc_symbol *symbol)
! {
! HOST_WIDE_INT n, element_size;
! mpz_t num_elements;
if (symbol->ts.type == BT_CHARACTER)
gfc_conv_const_charlen (symbol->ts.cl);
+
+ if (symbol->as == NULL || !gfc_is_nodesc_array (symbol))
+ /* In the array case, we need the size of the array descriptor. */
+ return int_size_in_bytes (gfc_sym_type (symbol));
+
+ /* Calculate the size of the array, which is
element_size*num_elements. */
element_size = int_size_in_bytes (gfc_typenode_for_spec (&symbol->ts));
! if (spec_size (symbol->as, &num_elements) == FAILURE)
gfc_internal_error ("calculate_length(): Unable to determine array
size");
! n = mpz_get_ui (num_elements);
! mpz_clear (num_elements);
! return n*element_size;
}
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [gfortran] Patch: Fix PR 13415
2004-07-09 21:09 [gfortran] Patch: Fix PR 13415 Tobias Schlüter
@ 2004-07-10 7:08 ` Paul Brook
2004-07-10 14:43 ` [gfortran, committed] " Tobias Schlüter
0 siblings, 1 reply; 3+ messages in thread
From: Paul Brook @ 2004-07-10 7:08 UTC (permalink / raw)
To: fortran; +Cc: Tobias Schlüter, patch
On Friday 09 July 2004 20:52, Tobias Schlüter wrote:
> PR 13415 was a problem with array pointers in common blocks: we failed
> when trying to calculate the array size, when in fact we should have
> been storing the array descriptor.
You've tripped over another of the rules I forgot to document:
Calling gfc_sym_type multiple times for the same symbol is generally a bad
idea. I think it's safe in this case, but it's definitely wasteful.
I changed the patch to remember and reuse the field type, rearranging a bit of
code in the process.
Tested on i686-linux. Applied to mainline.
> Built and tested on i686-pc-linux. Since the original code had some
> reminiscences of its origin in g95, there are whitespace changes in the
> patch, I also changed the variable names to something more expressive.
>
> trans-common.c is in fact full of trailing whitespace, which I will
> remove in a follow-up patch, and, if people agree, I will change some
> variable names to something more expressive also in other functions.
> Since I won't be intermingling those changes with functional changes
> those changes shouldn't hurt.
Ok.
Paul
2004-07-10 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
Paul Brook <paul@codesourcery.com>
PR fortran/13415
* trans-common.c (calculate_length): Remove ...
(get_segment_info): Merge into here. Save field type.
(build_field): Use saved type.
(create_common, new_condition, new_segment, finish_equivalences):
Use new get_segment_info.
* trans-types.c: Update comment.
testsuite
* gfortran.dg/common_pointer_1.f90: New test.
Index: trans-common.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans-common.c,v
retrieving revision 1.9
diff -u -p -r1.9 trans-common.c
--- trans-common.c 29 Jun 2004 22:11:38 -0000 1.9
+++ trans-common.c 10 Jul 2004 01:58:48 -0000
@@ -106,11 +106,13 @@ Software Foundation, 59 Temple Place - S
#include <assert.h>
+/* Holds a single variable in a equivalence set. */
typedef struct segment_info
{
gfc_symbol *sym;
HOST_WIDE_INT offset;
HOST_WIDE_INT length;
+ /* This will contain the field type until the field is created. */
tree field;
struct segment_info *next;
} segment_info;
@@ -119,11 +121,31 @@ static segment_info *current_segment, *c
static HOST_WIDE_INT current_offset;
static gfc_namespace *gfc_common_ns = NULL;
-#define get_segment_info() gfc_getmem (sizeof (segment_info))
-
#define BLANK_COMMON_NAME "__BLNK__"
+/* Make a segment_info based on a symbol. */
+
+static segment_info *
+get_segment_info (gfc_symbol * sym, HOST_WIDE_INT offset)
+{
+ segment_info *s;
+
+ /* Make sure we've got the character length. */
+ if (sym->ts.type == BT_CHARACTER)
+ gfc_conv_const_charlen (sym->ts.cl);
+
+ /* Create the segment_info and fill it in. */
+ s = (segment_info *) gfc_getmem (sizeof (segment_info));
+ s->sym = sym;
+ /* We will use this type when building the segment aggreagate type. */
+ s->field = gfc_sym_type (sym);
+ s->length = int_size_in_bytes (s->field);
+ s->offset = offset;
+
+ return s;
+}
+
/* Add combine segment V and segement LIST. */
static segment_info *
@@ -189,18 +211,19 @@ gfc_sym_mangled_common_id (const char *
}
-/* Build a filed declaration for a common variable or a local equivalence
+/* Build a field declaration for a common variable or a local equivalence
object. */
-static tree
+static void
build_field (segment_info *h, tree union_type, record_layout_info rli)
{
- tree type = gfc_sym_type (h->sym);
- tree name = get_identifier (h->sym->name);
- tree field = build_decl (FIELD_DECL, name, type);
+ tree field;
+ tree name;
HOST_WIDE_INT offset = h->offset;
unsigned HOST_WIDE_INT desired_align, known_align;
+ name = get_identifier (h->sym->name);
+ field = build_decl (FIELD_DECL, name, h->field);
known_align = (offset & -offset) * BITS_PER_UNIT;
if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
known_align = BIGGEST_ALIGNMENT;
@@ -218,7 +241,7 @@ build_field (segment_info *h, tree union
size_binop (PLUS_EXPR,
DECL_FIELD_OFFSET (field),
DECL_SIZE_UNIT (field)));
- return field;
+ h->field = field;
}
@@ -340,13 +363,12 @@ create_common (gfc_common_head *com, con
for (h = current_common; h; h = next_s)
{
- tree field;
- field = build_field (h, union_type, rli);
+ build_field (h, union_type, rli);
/* Link the field into the type. */
- *field_link = field;
- field_link = &TREE_CHAIN (field);
- h->field = field;
+ *field_link = h->field;
+ field_link = &TREE_CHAIN (h->field);
+
/* Has initial value. */
if (h->sym->value)
is_init = true;
@@ -452,31 +474,6 @@ find_segment_info (gfc_symbol *symbol)
}
-/* Given a variable symbol, calculate the total length in bytes of the
- variable. */
-
-static HOST_WIDE_INT
-calculate_length (gfc_symbol *symbol)
-{
- HOST_WIDE_INT j, element_size;
- mpz_t elements;
-
- if (symbol->ts.type == BT_CHARACTER)
- gfc_conv_const_charlen (symbol->ts.cl);
- element_size = int_size_in_bytes (gfc_typenode_for_spec (&symbol->ts));
- if (symbol->as == NULL)
- return element_size;
-
- /* Calculate the number of elements in the array */
- if (spec_size (symbol->as, &elements) == FAILURE)
- gfc_internal_error ("calculate_length(): Unable to determine array
size");
- j = mpz_get_ui (elements);
- mpz_clear (elements);
-
- return j*element_size;;
-}
-
-
/* Given an expression node, make sure it is a constant integer and return
the mpz_t value. */
@@ -601,11 +598,8 @@ new_condition (segment_info *v, gfc_equi
offset1 = calculate_offset (eq1->expr);
offset2 = calculate_offset (eq2->expr);
- a = get_segment_info ();
-
- a->sym = eq2->expr->symtree->n.sym;
- a->offset = v->offset + offset1 - offset2;
- a->length = calculate_length (eq2->expr->symtree->n.sym);
+ a = get_segment_info (eq2->expr->symtree->n.sym,
+ v->offset + offset1 - offset2);
current_segment = add_segments (current_segment, a);
}
@@ -728,14 +722,11 @@ add_equivalences (void)
static void
new_segment (gfc_common_head *common, const char *name, gfc_symbol *sym)
{
- HOST_WIDE_INT length;
+ current_segment = get_segment_info (sym, current_offset);
+
+ /* The offset of the next common variable. */
+ current_offset += current_segment->length;
- current_segment = get_segment_info ();
- current_segment->sym = sym;
- current_segment->offset = current_offset;
- length = calculate_length (sym);
- current_segment->length = length;
-
/* Add all object directly or indirectly equivalenced with this common
variable. */
add_equivalences ();
@@ -745,8 +736,6 @@ new_segment (gfc_common_head *common, co
"to COMMON '%s' at %L",
sym->name, name, &common->where);
- /* The offset of the next common variable. */
- current_offset += length;
/* Add these to the common block. */
current_common = add_segments (current_common, current_segment);
@@ -768,10 +757,7 @@ finish_equivalences (gfc_namespace *ns)
{
if (y->used) continue;
sym = z->expr->symtree->n.sym;
- current_segment = get_segment_info ();
- current_segment->sym = sym;
- current_segment->offset = 0;
- current_segment->length = calculate_length (sym);
+ current_segment = get_segment_info (sym, 0);
/* All objects directly or indrectly equivalenced with this symbol.
*/
add_equivalences ();
Index: trans-types.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans-types.c,v
retrieving revision 1.5
diff -u -p -r1.5 trans-types.c
--- trans-types.c 29 Jun 2004 22:01:35 -0000 1.5
+++ trans-types.c 10 Jul 2004 02:24:15 -0000
@@ -916,7 +916,9 @@ gfc_build_pointer_type (gfc_symbol * sym
/* Return the type for a symbol. Special handling is required for character
types to get the correct level of indirection.
For functions return the return type.
- For subroutines return void_type_node. */
+ For subroutines return void_type_node.
+ Calling this multiple times for the same symbol should be avoided,
+ especially for character and array types. */
tree
gfc_sym_type (gfc_symbol * sym)
^ permalink raw reply [flat|nested] 3+ messages in thread
* [gfortran, committed] Re: Patch: Fix PR 13415
2004-07-10 7:08 ` Paul Brook
@ 2004-07-10 14:43 ` Tobias Schlüter
0 siblings, 0 replies; 3+ messages in thread
From: Tobias Schlüter @ 2004-07-10 14:43 UTC (permalink / raw)
To: Paul Brook; +Cc: fortran, patch
[-- Attachment #1: Type: text/plain, Size: 460 bytes --]
Paul Brook wrote:
>>trans-common.c is in fact full of trailing whitespace, which I will
>>remove in a follow-up patch, and, if people agree, I will change some
>>variable names to something more expressive also in other functions.
>>Since I won't be intermingling those changes with functional changes
>>those changes shouldn't hurt.
>
>
> Ok.
Done. I also changed one for loop in a trivial manner. Diff attached.
Built and tested on i686-pc-linux.
- Tobi
[-- Attachment #2: ws_diff.gz --]
[-- Type: application/postscript, Size: 5155 bytes --]
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2004-07-10 11:21 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2004-07-09 21:09 [gfortran] Patch: Fix PR 13415 Tobias Schlüter
2004-07-10 7:08 ` Paul Brook
2004-07-10 14:43 ` [gfortran, committed] " Tobias Schlüter
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).