===================================================================
*************** gfc_get_dtype_rank_type (int rank, tree
tree field;
vec<constructor_elt, va_gc> *v = NULL;
+ size = TYPE_SIZE_UNIT (etype);
+
switch (TREE_CODE (etype))
{
case INTEGER_TYPE:
*************** gfc_get_dtype_rank_type (int rank, tree
/* We will never have arrays of arrays. */
case ARRAY_TYPE:
n = BT_CHARACTER;
break;
case POINTER_TYPE:
n = BT_ASSUMED;
break;
default:
/* TODO: Don't do dtype for temporary descriptorless arrays. */
! /* We can strange array types for temporary arrays. */
return gfc_index_zero_node;
}
- size = TYPE_SIZE_UNIT (etype);
- if (n == BT_CHARACTER && size == NULL_TREE)
- size = TYPE_SIZE_UNIT (TREE_TYPE (etype));
-
tmp = get_dtype_type_node ();
field = gfc_advance_chain (TYPE_FIELDS (tmp),
GFC_DTYPE_ELEM_LEN);
/* We will never have arrays of arrays. */
case ARRAY_TYPE:
n = BT_CHARACTER;
+ if (size == NULL_TREE)
+ size = TYPE_SIZE_UNIT (TREE_TYPE (etype));
break;
case POINTER_TYPE:
n = BT_ASSUMED;
+ if (TREE_CODE (TREE_TYPE (etype)) != VOID_TYPE)
+ size = TYPE_SIZE_UNIT (TREE_TYPE (etype));
+ else
+ size = build_int_cst (size_type_node, 0);
break;
default:
/* TODO: Don't do dtype for temporary descriptorless arrays. */
! /* We can encounter strange array types for temporary arrays. */
return gfc_index_zero_node;
}
tmp = get_dtype_type_node ();
field = gfc_advance_chain (TYPE_FIELDS (tmp),
GFC_DTYPE_ELEM_LEN);
===================================================================
***************
+ ! { dg-do run }
+ !
+ ! Test the fix for PR85742 in which the descriptors, passed to alsize,
+ ! for 'a' and 'b' had the wrong element length.
+ !
+ ! Contributed by Cesar Philippidis <cesar@gcc.gnu.org>
+ !
+ program main
+ implicit none
+ integer, allocatable :: a
+ real, pointer :: b
+ integer, allocatable :: am(:,:)
+ real, pointer :: bm(:,:)
+
+ allocate (a)
+ allocate (b)
+ allocate (am(3,3))
+ allocate (bm(4,4))
+
+ if (sizeof (a) /= alsize (a)) stop 1
+ if (sizeof (b) /= alsize (b)) stop 2
+ if (sizeof (am) /= alsize (am)) stop 3
+ if (sizeof (bm) /= alsize (bm)) stop 4
+
+ deallocate (b)
+ deallocate (bm)
+ contains
+ function alsize (a)
+ integer alsize
+ type (*), dimension (..), contiguous :: a
+ alsize = sizeof(a)
+ end function
+ end program main
+