diff mbox

[Fortran] Coarray fixes for select type/associate and type of derived components

Message ID 53B0007F.9080908@net-b.de
State New
Headers show

Commit Message

Tobias Burnus June 29, 2014, 12:03 p.m. UTC 
This patch fixes some issues with polymorphic coarrays. I still have to 
fix at least one issue.

Fixed by the patch:

a) The temporary pointer generated with SELECT TYPE has to be a coarray. 
That's fixed with the resolve.c patch. The comment is also bogus: The 
comment is correct – and gfortran correctly detects coindexed variables 
as selector. However, in the code in question, the selector is not 
coindexed but the variable in the coindexed section is.

b) It doesn't make sense to try to initialize the temporary pointer of 
SELECT TYPE (or ASSOCIATE), thus we have to exclude it also in trans-decl.c

c) As the temporary variable is internally a pointer, the assert in 
trans-array.c also has to accept a pointer – even though coarrays with 
token in the descriptor can only be allocatable. But for code like 
"a(1)[1])", "a(1)" is not longer a pointer – and one ends up having an 
akind of unknown. Instead of adding all kind of values, I simply removed 
the assert.

d) In trans-intrinsic.c, one has a similar issue. We now avoid an ICE by 
checking whether the variable is set before accessing it.

e) For caf(:)[i]%a, we had the dtype of the descriptor of "caf" instead 
of "...%a". That's now fixed.

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias

PS: Still to be done for coarrays: Nonallocatable polymorphic coarray 
dummies. For those, the offset and the token is passed as additional 
argument – but that's not yet correctly handled with ASSOCIATE/SELECT TYPE.
Also to be done are more type-conversion checks (beyond those which are 
implicitly checked by this patch) – and the handling of vector subscripts.

Comments

Tobias Burnus July 2, 2014, 5:12 a.m. UTC | #1 
On June 29, 2014, Tobias Burnus wrote:
> This patch fixes some issues with polymorphic coarrays. I still have 
> to fix at least one issue.
>
> Fixed by the patch:
>
> a) The temporary pointer generated with SELECT TYPE has to be a 
> coarray. That's fixed with the resolve.c patch. The comment is also 
> bogus: The comment is correct – and gfortran correctly detects 
> coindexed variables as selector. However, in the code in question, the 
> selector is not coindexed but the variable in the coindexed section is.
>
> b) It doesn't make sense to try to initialize the temporary pointer of 
> SELECT TYPE (or ASSOCIATE), thus we have to exclude it also in 
> trans-decl.c
>
> c) As the temporary variable is internally a pointer, the assert in 
> trans-array.c also has to accept a pointer – even though coarrays with 
> token in the descriptor can only be allocatable. But for code like 
> "a(1)[1])", "a(1)" is not longer a pointer – and one ends up having an 
> akind of unknown. Instead of adding all kind of values, I simply 
> removed the assert.
>
> d) In trans-intrinsic.c, one has a similar issue. We now avoid an ICE 
> by checking whether the variable is set before accessing it.
>
> e) For caf(:)[i]%a, we had the dtype of the descriptor of "caf" 
> instead of "...%a". That's now fixed.
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
>
> Tobias
>
> PS: Still to be done for coarrays: Nonallocatable polymorphic coarray 
> dummies. For those, the offset and the token is passed as additional 
> argument – but that's not yet correctly handled with ASSOCIATE/SELECT 
> TYPE.
> Also to be done are more type-conversion checks (beyond those which 
> are implicitly checked by this patch) – and the handling of vector 
> subscripts.
Tobias Burnus July 4, 2014, 6:02 a.m. UTC | #2 
Another somewhat early PING**2

> On June 29, 2014, Tobias Burnus wrote:
>> This patch fixes some issues with polymorphic coarrays. I still have 
>> to fix at least one issue.
>>
>> Fixed by the patch:
>>
>> a) The temporary pointer generated with SELECT TYPE has to be a 
>> coarray. That's fixed with the resolve.c patch. The comment is also 
>> bogus: The comment is correct – and gfortran correctly detects 
>> coindexed variables as selector. However, in the code in question, 
>> the selector is not coindexed but the variable in the coindexed 
>> section is.
>>
>> b) It doesn't make sense to try to initialize the temporary pointer 
>> of SELECT TYPE (or ASSOCIATE), thus we have to exclude it also in 
>> trans-decl.c
>>
>> c) As the temporary variable is internally a pointer, the assert in 
>> trans-array.c also has to accept a pointer – even though coarrays 
>> with token in the descriptor can only be allocatable. But for code 
>> like "a(1)[1])", "a(1)" is not longer a pointer – and one ends up 
>> having an akind of unknown. Instead of adding all kind of values, I 
>> simply removed the assert.
>>
>> d) In trans-intrinsic.c, one has a similar issue. We now avoid an ICE 
>> by checking whether the variable is set before accessing it.
>>
>> e) For caf(:)[i]%a, we had the dtype of the descriptor of "caf" 
>> instead of "...%a". That's now fixed.
>>
>> Build and regtested on x86-64-gnu-linux.
>> OK for the trunk?
>>
>> Tobias
>>
>> PS: Still to be done for coarrays: Nonallocatable polymorphic coarray 
>> dummies. For those, the offset and the token is passed as additional 
>> argument – but that's not yet correctly handled with ASSOCIATE/SELECT 
>> TYPE.
>> Also to be done are more type-conversion checks (beyond those which 
>> are implicitly checked by this patch) – and the handling of vector 
>> subscripts.
Paul Richard Thomas July 4, 2014, 7:04 p.m. UTC | #3 
Dear Tobias,

This looks absolutely fine to me - good for trunk.

Thanks for the patch and for the overall co-array effort.

Paul

On 4 July 2014 08:02, Tobias Burnus <burnus@net-b.de> wrote:
> Another somewhat early PING**2
>
>
>> On June 29, 2014, Tobias Burnus wrote:
>>>
>>> This patch fixes some issues with polymorphic coarrays. I still have to
>>> fix at least one issue.
>>>
>>> Fixed by the patch:
>>>
>>> a) The temporary pointer generated with SELECT TYPE has to be a coarray.
>>> That's fixed with the resolve.c patch. The comment is also bogus: The
>>> comment is correct – and gfortran correctly detects coindexed variables as
>>> selector. However, in the code in question, the selector is not coindexed
>>> but the variable in the coindexed section is.
>>>
>>> b) It doesn't make sense to try to initialize the temporary pointer of
>>> SELECT TYPE (or ASSOCIATE), thus we have to exclude it also in trans-decl.c
>>>
>>> c) As the temporary variable is internally a pointer, the assert in
>>> trans-array.c also has to accept a pointer – even though coarrays with token
>>> in the descriptor can only be allocatable. But for code like "a(1)[1])",
>>> "a(1)" is not longer a pointer – and one ends up having an akind of unknown.
>>> Instead of adding all kind of values, I simply removed the assert.
>>>
>>> d) In trans-intrinsic.c, one has a similar issue. We now avoid an ICE by
>>> checking whether the variable is set before accessing it.
>>>
>>> e) For caf(:)[i]%a, we had the dtype of the descriptor of "caf" instead
>>> of "...%a". That's now fixed.
>>>
>>> Build and regtested on x86-64-gnu-linux.
>>> OK for the trunk?
>>>
>>> Tobias
>>>
>>> PS: Still to be done for coarrays: Nonallocatable polymorphic coarray
>>> dummies. For those, the offset and the token is passed as additional
>>> argument – but that's not yet correctly handled with ASSOCIATE/SELECT TYPE.
>>> Also to be done are more type-conversion checks (beyond those which are
>>> implicitly checked by this patch) – and the handling of vector subscripts.
diff mbox

Patch

2014-06-29  Tobias Burnus  <burnus@net-b.de>

	* resolve.c (resolve_assoc_var): Fix corank setting.
	* trans-array.c (gfc_conv_descriptor_token): Change assert.
	for select-type temporaries.
	* trans-decl.c (generate_coarray_sym_init): Skip for
	attr.select_type_temporary. 
	* trans-expr.c (gfc_conv_procedure_call): Fix for
	select-type temporaries.
	* trans-intrinsic.c (get_caf_token_offset): Ditto.
	(gfc_conv_intrinsic_caf_get, gfc_conv_intrinsic_caf_send): Set
	the correct dtype.
	* trans-types.h (gfc_get_dtype_rank_type): New.
	* trans-types.c (gfc_get_dtype_rank_type): Ditto.

2014-06-29  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/coarray/coindexed_3.f90: New.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index ca20c29..15d8dab 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7912,10 +7912,7 @@  resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
       sym->as = gfc_get_array_spec ();
       sym->as->rank = target->rank;
       sym->as->type = AS_DEFERRED;
-
-      /* Target must not be coindexed, thus the associate-variable
-	 has no corank.  */
-      sym->as->corank = 0;
+      sym->as->corank = gfc_get_corank (target);
     }
 
   /* Mark this as an associate variable.  */
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 5558217..0e01899 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -298,7 +298,6 @@  gfc_conv_descriptor_token (tree desc)
 
   type = TREE_TYPE (desc);
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
-  gcc_assert (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE);
   gcc_assert (gfc_option.coarray == GFC_FCOARRAY_LIB);
   field = gfc_advance_chain (TYPE_FIELDS (type), CAF_TOKEN_FIELD);
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index cbcd52d..93c59b1 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4670,7 +4670,8 @@  generate_coarray_sym_init (gfc_symbol *sym)
   tree tmp, size, decl, token;
 
   if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension
-      || sym->attr.use_assoc || !sym->attr.referenced)
+      || sym->attr.use_assoc || !sym->attr.referenced
+      || sym->attr.select_type_temporary)
     return;
 
   decl = sym->backend_decl;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 7ee0206..dba51b0 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4813,7 +4813,8 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  caf_type = TREE_TYPE (caf_decl);
 
 	  if (GFC_DESCRIPTOR_TYPE_P (caf_type)
-	      && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE)
+	      && (GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE
+		  || GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_POINTER))
 	    tmp = gfc_conv_descriptor_token (caf_decl);
 	  else if (DECL_LANG_SPECIFIC (caf_decl)
 		   && GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index a1dfdfb..5aa5683 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1179,7 +1179,8 @@  get_caf_token_offset (tree *token, tree *offset, tree caf_decl, tree se_expr,
 
   /* Offset between the coarray base address and the address wanted.  */
   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl))
-      && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_ALLOCATABLE)
+      && (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_ALLOCATABLE
+	  || GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_POINTER))
     *offset = build_int_cst (gfc_array_index_type, 0);
   else if (DECL_LANG_SPECIFIC (caf_decl)
 	   && GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE)
@@ -1285,7 +1286,10 @@  gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind)
 	  ar->type = AR_FULL;
 	}
       gfc_conv_expr_descriptor (&argse, array_expr);
-
+      /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
+         has the wrong type if component references are done.  */
+      gfc_add_modify (&argse.pre, gfc_conv_descriptor_dtype (argse.expr),
+                      gfc_get_dtype_rank_type (array_expr->rank, type));
       if (has_vector)
 	{
 	  vec = conv_caf_vector_subscript (&argse.pre, argse.expr, ar);
@@ -1387,7 +1391,12 @@  conv_caf_send (gfc_code *code) {
 	}
       lhs_se.want_pointer = 1;
       gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
-      lhs_type = gfc_get_element_type (TREE_TYPE (TREE_TYPE (lhs_se.expr)));
+      /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
+         has the wrong type if component references are done.  */
+      lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
+      tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
+      gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
+                      gfc_get_dtype_rank_type (lhs_expr->rank, lhs_type));
       if (has_vector)
 	{
 	  vec = conv_caf_vector_subscript (&block, lhs_se.expr, ar);
@@ -1440,6 +1449,7 @@  conv_caf_send (gfc_code *code) {
          vector bounds separately.  */
       gfc_array_ref *ar, ar2;
       bool has_vector = false;
+      tree tmp2;
 
       if (gfc_is_coindexed (rhs_expr) && gfc_has_vector_subscript (rhs_expr))
 	{
@@ -1452,6 +1462,12 @@  conv_caf_send (gfc_code *code) {
 	}
       rhs_se.want_pointer = 1;
       gfc_conv_expr_descriptor (&rhs_se, rhs_expr);
+      /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
+         has the wrong type if component references are done.  */
+      tmp = build_fold_indirect_ref_loc (input_location, rhs_se.expr);
+      tmp2 = gfc_typenode_for_spec (&rhs_expr->ts);
+      gfc_add_modify (&rhs_se.pre, gfc_conv_descriptor_dtype (tmp),
+                      gfc_get_dtype_rank_type (rhs_expr->rank, tmp2));
       if (has_vector)
 	{
 	  rhs_vec = conv_caf_vector_subscript (&block, rhs_se.expr, ar);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index bb930f9..e55e2d9 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1395,23 +1395,13 @@  gfc_get_desc_dim_type (void)
    unknown cases abort.  */
 
 tree
-gfc_get_dtype (tree type)
+gfc_get_dtype_rank_type (int rank, tree etype)
 {
   tree size;
   int n;
   HOST_WIDE_INT i;
   tree tmp;
   tree dtype;
-  tree etype;
-  int rank;
-
-  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type));
-
-  if (GFC_TYPE_ARRAY_DTYPE (type))
-    return GFC_TYPE_ARRAY_DTYPE (type);
-
-  rank = GFC_TYPE_ARRAY_RANK (type);
-  etype = gfc_get_element_type (type);
 
   switch (TREE_CODE (etype))
     {
@@ -1477,6 +1467,26 @@  gfc_get_dtype (tree type)
   /* TODO: Check this is actually true, particularly when repacking
      assumed size parameters.  */
 
+  return dtype;
+}
+
+
+tree
+gfc_get_dtype (tree type)
+{
+  tree dtype;
+  tree etype;
+  int rank;
+
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type));
+
+  if (GFC_TYPE_ARRAY_DTYPE (type))
+    return GFC_TYPE_ARRAY_DTYPE (type);
+
+  rank = GFC_TYPE_ARRAY_RANK (type);
+  etype = gfc_get_element_type (type);
+  dtype = gfc_get_dtype_rank_type (rank, etype);
+
   GFC_TYPE_ARRAY_DTYPE (type) = dtype;
   return dtype;
 }
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 5ed87c0..bd3e69c 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -97,6 +97,7 @@  int gfc_return_by_reference (gfc_symbol *);
 int gfc_is_nodesc_array (gfc_symbol *);
 
 /* Return the DTYPE for an array.  */
+tree gfc_get_dtype_rank_type (int, tree);
 tree gfc_get_dtype (tree);
 
 tree gfc_get_ppc_type (gfc_component *);
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90
new file mode 100644
index 0000000..46488f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90
@@ -0,0 +1,71 @@ 
+! { dg-do run }
+!
+! Contributed by Reinhold Bader
+!
+
+program pmup
+  implicit none
+  type t
+    integer :: b, a
+  end type t
+
+  CLASS(*), allocatable :: a(:)[:]
+  integer :: ii
+
+  !! --- ONE --- 
+  allocate(real :: a(3)[*])
+  IF (this_image() == num_images()) THEN
+    SELECT TYPE (a)
+      TYPE IS (real)
+      a(:)[1] = 2.0
+    END SELECT
+  END IF
+  SYNC ALL
+
+  IF (this_image() == 1) THEN
+    SELECT TYPE (a)
+      TYPE IS (real)
+        IF (ALL(A(:)[1] == 2.0)) THEN
+          !WRITE(*,*) 'OK'
+        ELSE
+          WRITE(*,*) 'FAIL'
+          call abort()
+        END IF
+      TYPE IS (t)
+        ii = a(1)[1]%a
+        call abort()
+      CLASS IS (t)
+        ii = a(1)[1]%a
+        call abort()
+    END SELECT
+  END IF
+
+  !! --- TWO --- 
+  deallocate(a)
+  allocate(t :: a(3)[*])
+  IF (this_image() == num_images()) THEN
+    SELECT TYPE (a)
+      TYPE IS (t)
+      a(:)[1]%a = 4.0
+    END SELECT
+  END IF
+  SYNC ALL
+
+  IF (this_image() == 1) THEN
+    SELECT TYPE (a)
+   TYPE IS (real)
+      ii = a(1)[1]
+      call abort()
+    TYPE IS (t)
+      IF (ALL(A(:)[1]%a == 4.0)) THEN
+        !WRITE(*,*) 'OK'
+      ELSE
+        WRITE(*,*) 'FAIL'
+        call abort()
+      END IF
+    CLASS IS (t)
+      ii = a(1)[1]%a
+      call abort()
+    END SELECT
+  END IF
+end program