type = TREE_TYPE (dest);
if (POINTER_TYPE_P (type))
type = TREE_TYPE (type);
- if (!GFC_ARRAY_TYPE_P (type))
- return NULL_TREE;
-
- /* Determine the length of the array. */
- len = GFC_TYPE_ARRAY_SIZE (type);
- if (!len || TREE_CODE (len) != INTEGER_CST)
+ if (GFC_ARRAY_TYPE_P (type))
+ {
+ /* Determine the length of the array. */
+ len = GFC_TYPE_ARRAY_SIZE (type);
+ if (!len || TREE_CODE (len) != INTEGER_CST)
+ return NULL_TREE;
+ }
+ else if (GFC_DESCRIPTOR_TYPE_P (type)
+ && gfc_is_simply_contiguous (expr, false, false))
+ {
+ if (POINTER_TYPE_P (TREE_TYPE (dest)))
+ dest = build_fold_indirect_ref_loc (input_location, dest);
+ len = gfc_conv_descriptor_size (dest, GFC_TYPE_ARRAY_RANK (type));
+ dest = gfc_conv_descriptor_data_get (dest);
+ }
+ else
return NULL_TREE;
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- len = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, len,
- fold_convert (gfc_array_index_type, tmp));
-
/* If we are zeroing a local array avoid taking its address by emitting
a = {} instead. */
if (!POINTER_TYPE_P (TREE_TYPE (dest)))
dest, build_constructor (TREE_TYPE (dest),
NULL));
+ /* Multiply len by element size. */
+ tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+ len = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ len, fold_convert (gfc_array_index_type, tmp));
+
/* Convert arguments to the correct types. */
dest = fold_convert (pvoid_type_node, dest);
len = fold_convert (size_type_node, len);
--- /dev/null
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+
+subroutine test1(n)
+ implicit none
+ integer(8) :: n
+ real(4), allocatable :: z(:,:,:)
+
+ allocate(z(n, 100, 200))
+ z = 0
+end subroutine
+
+subroutine test2(n)
+ implicit none
+ integer(8) :: n
+ integer, allocatable :: z(:,:,:)
+
+ allocate(z(n, 100, 200))
+ z = 0
+end subroutine
+
+subroutine test3(n)
+ implicit none
+ integer(8) :: n
+ logical, allocatable :: z(:,:,:)
+
+ allocate(z(n, 100, 200))
+ z = .false.
+end subroutine
+
+subroutine test4(n, z)
+ implicit none
+ integer :: n
+ real, pointer :: z(:,:,:) ! need not be contiguous!
+ z = 0
+end subroutine
+
+subroutine test5(n, z)
+ implicit none
+ integer :: n
+ real, contiguous, pointer :: z(:,:,:)
+ z = 0
+end subroutine
+
+subroutine test6 (n, z)
+ implicit none
+ integer :: n
+ real, contiguous, pointer :: z(:,:,:)
+ z(:,::1,:) = 0
+end subroutine
+
+! { dg-final { scan-tree-dump-times "__builtin_memset" 5 "original" } }