From b95fc78fc7362b3e5cbe148e2df9f8cf2e82548c Mon Sep 17 00:00:00 2001
From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Tue, 24 Nov 2020 21:51:17 +0100
Subject: Fix coarrays in namelist.

gcc/fortran/ChangeLog:

	* trans-array.c (cas_array_ref): Correct assert.
	* trans-io.c (cas_nml_addr_expr): New function.
	(transfer_namelist_element): Call when needed.
---
 gcc/fortran/trans-array.c |  2 +-
 gcc/fortran/trans-io.c    | 40 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 40 insertions(+), 2 deletions(-)

(limited to 'gcc')

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0baea88..1a75bb5 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3015,7 +3015,7 @@ cas_add_this_image_offset (tree offset, tree desc, gfc_array_ref *ar,
 static gfc_ref *
 cas_array_ref (gfc_ref *ref)
 {
-  gcc_assert (flag_coarray = GFC_FCOARRAY_SHARED);
+  gcc_assert (flag_coarray == GFC_FCOARRAY_SHARED);
 
   for (; ref; ref = ref->next)
     {
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 666dc37..244f2c8 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1636,6 +1636,41 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
   return tmp;
 }
 
+/* Add the address expression of a shared coarray.  It is easiest to
+   use gfc_conv_expr which already does the right thing in this
+   case.  */
+
+static tree
+cas_nml_addr_expr (gfc_symbol *sym)
+{
+  gfc_se se;
+  gfc_expr *e = gfc_lval_expr_from_sym (sym);
+  int rank, corank;
+
+  e->ref = gfc_get_ref ();
+  e->ref->type = REF_ARRAY;
+  e->ref->u.ar.type = AR_ELEMENT;
+  rank = sym->as->rank;
+  corank = sym->as->corank;
+  e->ref->u.ar.dimen = rank;
+  e->ref->u.ar.codimen = corank;
+  e->ref->u.ar.as = sym->as;
+  e->ts = sym->ts;
+  for (int i = 0; i < rank; i++)
+    {
+      e->ref->u.ar.dimen_type[i] = DIMEN_ELEMENT;
+      e->ref->u.ar.start[i] = gfc_copy_expr (sym->as->lower[i]);
+    }
+
+  for (int i = rank; i < rank + corank; i++)
+    e->ref->u.ar.dimen_type[i] = DIMEN_THIS_IMAGE;
+
+  gfc_init_se (&se, NULL);
+  se.want_pointer = 1;
+  gfc_conv_expr (&se, e);
+  gfc_free_expr (e);
+  return se.expr;
+}
 
 /* For an object VAR_NAME whose base address is BASE_ADDR, generate a
    call to iocall[IOCALL_SET_NML_VAL].  For derived type variable, recursively
@@ -1679,7 +1714,10 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
   else
     as = sym ? CLASS_DATA (sym)->as : CLASS_DATA (c)->as;
 
-  addr_expr = nml_get_addr_expr (sym, c, base_addr);
+  if (flag_coarray == GFC_FCOARRAY_SHARED && sym->attr.codimension)
+    addr_expr = cas_nml_addr_expr (sym);
+  else
+    addr_expr = nml_get_addr_expr (sym, c, base_addr);
 
   if (as)
     rank = as->rank;
-- 
cgit v1.1