Dear all,

the attached patch fixes a rejects-valid: in an ALLOCATE statement with
MOLD= present, if the allocate-object has an explicit-shape-spec, the
compatibility of ranks is not required by the standard.  (It is
explicitly required only for SOURCE=).

Since this could surprise users, we emit a warning if -Wsurprising is
specified (contained in -Wall).  This agrees with NAG's behavior.

Testcase cross-checked with ifx and NAG.

Regtested on x86_64-pc-linux-gnu.  OK for mainline / 15-branch?

Thanks,
Harald

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d09aef0a899..25d12768e97 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8740,8 +8767,25 @@ static bool
 conformable_arrays (gfc_expr *e1, gfc_expr *e2)
 {
   gfc_ref *tail;
+  bool scalar;
+
   for (tail = e2->ref; tail && tail->next; tail = tail->next);
 
+  /* If MOLD= is present and is not scalar, and the allocate-object has an
+     explicit-shape-spec, the ranks need not agree.  Let's emit a warning if
+     -pedantic is given.  */
+  scalar = !tail || tail->type == REF_COMPONENT;
+  if (e1->mold && e1->rank > 0
+      && (scalar || (tail->type == REF_ARRAY && tail->u.ar.type != AR_FULL)))
+    {
+      if (scalar || (tail->u.ar.as && e1->rank != tail->u.ar.as->rank))
+	gfc_warning (OPT_Wpedantic, "Allocate-object at %L has rank %d "
+		     "but MOLD= expression at %L has rank %d",
+		     &e2->where, scalar ? 0 : tail->u.ar.as->rank,
+		     &e1->where, e1->rank);
+      return true;
+    }
+
   /* First compare rank.  */
   if ((tail && (!tail->u.ar.as || e1->rank != tail->u.ar.as->rank))
       || (!tail && e1->rank != e2->rank))

Reply via email to