Fix allocation with source for coarrays.

gcc/fortran/ChangeLog:

	* resolve.c (gfc_expr_to_initialize): Check for coarrays only
	if the reference is right.
	* trans-array.c	(gfc_array_allocate): If SOURCE has a size,
	use it.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 40a2f6fb2d9045881dd729e7e0f2211f1083b91b..106df27416a4c7790c9994c80ce3484277aa5a23 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7619,21 +7619,21 @@ gfc_expr_to_initialize (gfc_expr *e)
            gfc_free_expr (ref->u.ar.stride[i]);
            ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL;
          }
+
+       if (flag_coarray == GFC_FCOARRAY_SHARED)
+         for (i = ref->u.ar.dimen; i < ref->u.ar.dimen + ref->u.ar.codimen;
+              i++)
+           {
+             gfc_free_expr (ref->u.ar.start[i]);
+             gfc_free_expr (ref->u.ar.end[i]);
+             gfc_free_expr (ref->u.ar.stride[i]);
+             ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i]
+               = NULL;
+             ref->u.ar.dimen_type[i] = DIMEN_THIS_IMAGE;
+           }
        break;
       }
 
-  if (flag_coarray == GFC_FCOARRAY_SHARED)
-    {
-      for (i = ref->u.ar.dimen; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
-       {
-         gfc_free_expr (ref->u.ar.start[i]);
-         gfc_free_expr (ref->u.ar.end[i]);
-         gfc_free_expr (ref->u.ar.stride[i]);
-         ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL;
-         ref->u.ar.dimen_type[i] = DIMEN_THIS_IMAGE;
-       }
-    }
-
   gfc_free_shape (&result->shape, result->rank);
 
   /* Recalculate rank, shape, etc.  */

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 1e3579e554aa2a413eee6376ab144deeb940c84b..a5455fc52269700939576c3d0ca990a48c267554 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6184,8 +6184,11 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 
   if (coarray && flag_coarray == GFC_FCOARRAY_SHARED)
     {
-      tree elem_size
-           = size_in_bytes (gfc_get_element_type (TREE_TYPE(se->expr)));
+      tree elem_size;
+      if (expr3_elem_size != NULL_TREE)
+       elem_size = expr3_elem_size;
+      else
+       elem_size = size_in_bytes (gfc_get_element_type (TREE_TYPE(se->expr)));
       int alloc_type
             = gfc_cas_get_allocation_type (expr->symtree->n.sym);
       gfc_allocate_shared_coarray (&elseblock, se->expr, elem_size,

diff --git a/gcc/testsuite/gfortran.dg/caf-shared/send_char_array_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/send_char_array_1.f90
new file mode 100644 (file)
index 0000000..d53ccfc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/send_char_array_1.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "2" }
+
+program send_convert_char_array
+
+  implicit none
+
+  character(kind=1, len=:), allocatable, codimension[:] :: co_str_k1_scal
+  character(kind=1, len=:), allocatable :: str_k1_scal
+  character(kind=4, len=:), allocatable, codimension[:] :: co_str_k4_scal
+  character(kind=4, len=:), allocatable :: str_k4_scal
+
+  character(kind=1, len=:), allocatable, codimension[:] :: co_str_k1_arr(:)
+  character(kind=1, len=:), allocatable :: str_k1_arr(:)
+  character(kind=4, len=:), allocatable, codimension[:] :: co_str_k4_arr(:)
+  character(kind=4, len=:), allocatable :: str_k4_arr(:)
+
+  allocate(str_k1_scal, SOURCE='abcdefghij')
+  allocate(str_k4_scal, SOURCE=4_'abcdefghij')
+  allocate(character(len=20)::co_str_k1_scal[*]) ! allocate syncs here
+  allocate(character(kind=4, len=20)::co_str_k4_scal[*]) ! allocate syncs here
+
+  allocate(str_k1_arr, SOURCE=['abc', 'EFG', 'klm', 'NOP'])
+  allocate(str_k4_arr, SOURCE=[4_'abc', 4_'EFG', 4_'klm', 4_'NOP'])
+  allocate(character(len=5)::co_str_k1_arr(4)[*])
+  allocate(character(kind=4, len=5)::co_str_k4_arr(4)[*])
+
+  ! First check send/copy to self
+  co_str_k1_scal[this_image()] = str_k1_scal
+  if (co_str_k1_scal /= str_k1_scal // '          ') STOP 1
+
+  co_str_k4_scal[this_image()] = str_k4_scal
+  if (co_str_k4_scal /= str_k4_scal // 4_'          ') STOP 2
+
+  co_str_k4_scal[this_image()] = str_k1_scal
+  if (co_str_k4_scal /= str_k4_scal // 4_'          ') STOP 3
+
+  co_str_k1_scal[this_image()] = str_k4_scal
+  if (co_str_k1_scal /= str_k1_scal // '          ') STOP 4
+
+  co_str_k1_arr(:)[this_image()] = str_k1_arr
+  if (any(co_str_k1_arr /= ['abc  ', 'EFG  ', 'klm  ', 'NOP  '])) STOP 5
+ 
+  co_str_k4_arr(:)[this_image()] = [4_'abc', 4_'EFG', 4_'klm', 4_'NOP']! str_k4_arr
+  if (any(co_str_k4_arr /= [4_'abc  ', 4_'EFG  ', 4_'klm  ', 4_'NOP  '])) STOP 6
+
+  co_str_k4_arr(:)[this_image()] = str_k1_arr
+  if (any(co_str_k4_arr /= [ 4_'abc  ', 4_'EFG  ', 4_'klm  ', 4_'NOP  '])) STOP 7
+
+  co_str_k1_arr(:)[this_image()] = str_k4_arr
+  if (any(co_str_k1_arr /= ['abc  ', 'EFG  ', 'klm  ', 'NOP  '])) STOP 8
+
+end program send_convert_char_array
+
+! vim:ts=2:sts=2:sw=2: