[PATCH/RFA] PR gdb/648

David Lecomber
2004-08-06T22:10:13Z

[-- Attachment #1: Type: text/plain, Size: 1201 bytes --]

This is a fix for a long-standing bug with multi-dimensional arrays in
fortran. When printing individual elements of an array,
evaluate_subexp_standard understood the dimensions of the array to be in
the opposite order to that of the whatis or entire array printing. This
led to bug 648, which was present for G77 compiled code, but the problem
was reversed for commercial compilers such as Intel or Portland.

G77 puts things in row-major order, as far as I can ascertain all other
fortran compilers do column major. This is handled in the dwarf2read
change, and now column major array types are reversed during the reading
to fit with GDB's struct type.

2004-08-06 David Lecomber <dsl@sources.redhat.com>

Fix PR gdb/648
* dwarf2read.c (read_array_type): Handle column major arrays
correctly. Assume column major for Fortran except with G77
compiler.
* eval.c (evaluate_subexp_standard): Assume Fortran arrays are
oriented large to small in type structure.

Attached is a test program and test script, should return true for all
comparisons..

I'm sure there'll be some comments, so please feel free to suggest some
reformatting!

David.

[-- Attachment #2: parts.patches --]
[-- Type: text/x-patch, Size: 5862 bytes --]

Index: gdb/dwarf2read.c
===================================================================
RCS file: /cvs/src/src/gdb/dwarf2read.c,v
retrieving revision 1.156
diff -c -p -r1.156 dwarf2read.c
*** gdb/dwarf2read.c 6 Jul 2004 19:29:30 -0000 1.156
--- gdb/dwarf2read.c 28 Jul 2004 13:03:05 -0000
*************** read_array_type (struct die_info *die, s
*** 3718,3726 ****

/* Dwarf2 dimensions are output from left to right, create the
necessary array types in backwards order. */
type = element_type;
! while (ndim-- > 0)
! type = create_array_type (NULL, type, range_types[ndim]);

/* Understand Dwarf2 support for vector types (like they occur on
the PowerPC w/ AltiVec). Gcc just adds another attribute to the
--- 3720,3751 ----

/* Dwarf2 dimensions are output from left to right, create the
necessary array types in backwards order. */
+
+ /* Take account of array ordering, if possible. */
type = element_type;
!
! attr = dwarf2_attr (die, DW_AT_ordering, cu);
!
! /* Trust this attribute if present. If not, assume col-major for FORTRAN
! unless the compiler is GNU F77 which puts things the opposite way to the
! dwarf2 spec.
!
! FIXME: dsl/2004-07-20: If G77 is ever fixed by checking version string of
! producer.
! */
! if ((attr && (DW_SND(attr) == DW_ORD_col_major))
! || (!attr && ( cu->language == language_fortran &&
! ( !cu->producer || !strstr(cu->producer, "GNU F77" )))))
! {
! int i = 0;
! while (i < ndim)
! type = create_array_type (NULL, type, range_types[i++]);
! }
! else
! {
! while (ndim-- > 0)
! type = create_array_type (NULL, type, range_types[ndim]);
! }

/* Understand Dwarf2 support for vector types (like they occur on
the PowerPC w/ AltiVec). Gcc just adds another attribute to the
Index: gdb/eval.c
===================================================================
RCS file: /cvs/src/src/gdb/eval.c,v
retrieving revision 1.41
diff -c -p -r1.41 eval.c
*** gdb/eval.c 8 Apr 2004 21:18:12 -0000 1.41
--- gdb/eval.c 28 Jul 2004 13:03:07 -0000
*************** evaluate_subexp_standard (struct type *e
*** 1610,1618 ****

multi_f77_subscript:
{
! int subscript_array[MAX_FORTRAN_DIMS + 1]; /* 1-based array of
! subscripts, max == 7 */
! int array_size_array[MAX_FORTRAN_DIMS + 1];
int ndimensions = 1, i;
struct type *tmp_type;
int offset_item; /* The array offset where the item lives */
--- 1610,1617 ----

multi_f77_subscript:
{
! int subscript_array[MAX_FORTRAN_DIMS];
! int array_size_array[MAX_FORTRAN_DIMS];
int ndimensions = 1, i;
struct type *tmp_type;
int offset_item; /* The array offset where the item lives */
*************** evaluate_subexp_standard (struct type *e
*** 1630,1636 ****
let us actually find out where this element exists in the array. */

offset_item = 0;
! for (i = 1; i <= nargs; i++)
{
/* Evaluate each subscript, It must be a legal integer in F77 */
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
--- 1629,1636 ----
let us actually find out where this element exists in the array. */

offset_item = 0;
! /* Take array indices left to right */
! for (i = 0; i < nargs; i++)
{
/* Evaluate each subscript, It must be a legal integer in F77 */
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
*************** evaluate_subexp_standard (struct type *e
*** 1638,1644 ****
--- 1638,1648 ----
/* Fill in the subscript and array size arrays */

subscript_array[i] = value_as_long (arg2);
+ }

+ /* Internal type of array is arranged right to left */
+ for (i = 0; i < nargs; i++)
+ {
retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
if (retcode == BOUND_FETCH_ERROR)
error ("Cannot obtain dynamic upper bound");
*************** evaluate_subexp_standard (struct type *e
*** 1647,1657 ****
if (retcode == BOUND_FETCH_ERROR)
error ("Cannot obtain dynamic lower bound");

! array_size_array[i] = upper - lower + 1;

/* Zero-normalize subscripts so that offsetting will work. */

! subscript_array[i] -= lower;

/* If we are at the bottom of a multidimensional
array type then keep a ptr to the last ARRAY
--- 1651,1661 ----
if (retcode == BOUND_FETCH_ERROR)
error ("Cannot obtain dynamic lower bound");

! array_size_array[nargs - i - 1] = upper - lower + 1;

/* Zero-normalize subscripts so that offsetting will work. */

! subscript_array[nargs - i - 1] -= lower;

/* If we are at the bottom of a multidimensional
array type then keep a ptr to the last ARRAY
*************** evaluate_subexp_standard (struct type *e
*** 1661,1677 ****
of base element type that we apply a simple
offset to. */

! if (i < nargs)
tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
}

/* Now let us calculate the offset for this item */

! offset_item = subscript_array[ndimensions];

! for (i = ndimensions - 1; i >= 1; i--)
offset_item =
! array_size_array[i] * offset_item + subscript_array[i];

/* Construct a value node with the value of the offset */

--- 1665,1681 ----
of base element type that we apply a simple
offset to. */

! if (i < nargs - 1)
tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
}

/* Now let us calculate the offset for this item */

! offset_item = subscript_array[ndimensions - 1];

! for (i = ndimensions - 1; i > 0; --i)
offset_item =
! array_size_array[i - 1] * offset_item + subscript_array[i - 1];

/* Construct a value node with the value of the offset */

[-- Attachment #3: arrays.gdb --]
[-- Type: text/plain, Size: 354 bytes --]

set height 0
b arrays.f:45
r
p onedi(4).eq.4
p twodi(4,5).eq.(4*5)
p twodi(14,3).eq.(14*3)
p threedi(2,3,4).eq.(2*3+4)
p threedi(1,4,5).eq.(1*4+5)
p threedi(3,4,5).eq.(3*4+5)
p fourdi(1,4,2,3).eq.(1*4+2*3)
p fourdi(2,4,3,3).eq.(2*4+3*3)
p fourdi(3,3,2,3).eq.(3*3+2*3)
p fourdi(3,2,1,2).eq.(3*2+1*2)
whatis onedi
whatis twodi
whatis threedi
whatis fourdi

[-- Attachment #4: arrays.f --]
[-- Type: text/x-fortran, Size: 2547 bytes --]

program first

INTEGER X,Y,Z
INTEGER i, j, k, l
INTEGER onedi(10)
INTEGER twodi(20,10)
INTEGER threedi(3, 5, 7)
INTEGER fourdi(4, 5, 7, 11)

REAL*4 onedf(10)
REAL*4 twodf(20,10)
REAL*4 threedf(3, 5, 7)
REAL*4 fourdf(4, 5, 7, 11)

DO i=1,10
onedi(i) = i
ENDDO

DO i=1,20
DO j=1,10
twodi(i,j) = i * j
ENDDO
ENDDO

DO i=1,3
DO j=1,5
DO k=1,7
threedi(i,j,k) = i * j + k
ENDDO
ENDDO
ENDDO

DO i=1,3
DO j=1,5
DO k=1,7
DO m=1,11
fourdi(i,j,k,m) = i * j + k * m
ENDDO
ENDDO
ENDDO
ENDDO

call oneif(onedi)
call twoif(twodi)
call threeif(threedi)
call fourif(fourdi)

DO i=1,10
onedf(i) = i
ENDDO

DO i=1,20
DO j=1,10
twodf(i,j) = i * j
ENDDO
ENDDO

DO i=1,3
DO j=1,5
DO k=1,7
threedf(i,j,k) = i * j + k
ENDDO
ENDDO
ENDDO

DO i=1,3
DO j=1,5
DO k=1,7
DO m=1,11
fourdf(i,j,k,m) = i * j + k * m
ENDDO
ENDDO
ENDDO
ENDDO

call oneff(onedf)
call twoff(twodf)
call threeff(threedf)
call fourff(fourdf)

call known(fourdf, m)

END

SUBROUTINE oneif (array1)
INTEGER array1(*)
array1(1) = 1
RETURN
END

SUBROUTINE twoif (array2)
INTEGER array2(20, *)
array2(1,1) = 11
RETURN
END

SUBROUTINE threeif (array3)
INTEGER array3(3, 5, *)
array3(1,1,1) = 111
RETURN
END

SUBROUTINE fourif (array4)
INTEGER array4(4, 5, 7, *)
array4(1,1,1,1) = 1111
RETURN
END

SUBROUTINE oneff (array1)
REAL*4 array1(*)
array1(1) = 1
RETURN
END

SUBROUTINE twoff (array2)
REAL*4 array2(20, *)
array2(1,1) = 11
RETURN
END

SUBROUTINE threeff (array3)
REAL*4 array3(3, 5, *)
array3(1,1,1) = 111
RETURN
END

SUBROUTINE fourff (array4)
REAL*4 array4(4, 5, 7, *)
array4(1,1,1,1) = 1111
RETURN
END

SUBROUTINE known (array4, i)
INTEGER i
REAL*4 array4(4, 5, 7, i)
array4(1,1,1,1) = 1111
RETURN
END