Am 15.06.25 um 21:25 schrieb Harald Anlauf:
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=).
Oops, I attached the wrong patch. Fixed now...
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
Harald
From 7194cdde73ed2b2c6ad6bc1a200a9f508c9659fa Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Sun, 15 Jun 2025 21:09:28 +0200
Subject: [PATCH] Fortran: fix checking of MOLD= in ALLOCATE statements
[PR51961]
In ALLOCATE statements where the MOLD= argument is present and is not
scalar, and the allocate-object has an explicit-shape-spec, the standard
does not require the ranks to agree. In that case we skip the rank check,
but emit a warning if -Wsurprising is given.
PR fortran/51961
gcc/fortran/ChangeLog:
* resolve.cc (conformable_arrays): Use modified rank check when
MOLD= expression is given.
gcc/testsuite/ChangeLog:
* gfortran.dg/allocate_with_mold_5.f90: New test.
---
gcc/fortran/resolve.cc | 17 +++++++
.../gfortran.dg/allocate_with_mold_5.f90 | 51 +++++++++++++++++++
2 files changed, 68 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_mold_5.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d09aef0a899..5413d8f9c54 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8740,8 +8740,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. This may be unintended,
+ so let's emit a warning if -Wsurprising 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_Wsurprising, "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))
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_mold_5.f90 b/gcc/testsuite/gfortran.dg/allocate_with_mold_5.f90
new file mode 100644
index 00000000000..f5e2fc93d0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_mold_5.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-additional-options "-Wsurprising" }
+!
+! PR fortran/51961 - fix checking of MOLD= in ALLOCATE statements
+!
+! Contributed by Tobias Burnus
+
+program p
+ implicit none
+ type t
+ end type t
+ type u
+ class(t), allocatable :: a(:), b(:,:), c
+ end type u
+ class(T), allocatable :: a(:), b(:,:), c
+ type(u) :: z
+
+ allocate (b(2,2))
+ allocate (z% b(2,2))
+
+ allocate (a(2), mold=b(:,1))
+ allocate (a(1:2), mold=b(1,:))
+ allocate (a(2), mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (a(1:2), mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% a(2), mold=b(:,1))
+ allocate (z% a(1:2), mold=b(1,:))
+ allocate (z% a(2), mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% a(1:2), mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% a(2), mold=z% b(:,1))
+ allocate (z% a(1:2), mold=z% b(1,:))
+ allocate (z% a(2), mold=z% b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% a(1:2), mold=z% b) ! { dg-warning "but MOLD= expression at" }
+
+ allocate (c, mold=b(1,1))
+ allocate (c, mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% c, mold=b(1,1))
+ allocate (z% c, mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% c, mold=z% b(1,1))
+ allocate (z% c, mold=z% b) ! { dg-warning "but MOLD= expression at" }
+
+ allocate (a, mold=b(:,1))
+ allocate (a, mold=b(1,:))
+ allocate (z% a, mold=b(:,1))
+ allocate (z% a, mold=b(1,:))
+ allocate (z% a, mold=z% b(:,1))
+ allocate (z% a, mold=z% b(1,:))
+
+ allocate (a, mold=b) ! { dg-error "or have the same rank" }
+ allocate (z% a, mold=b) ! { dg-error "or have the same rank" }
+ allocate (z% a, mold=z% b) ! { dg-error "or have the same rank" }
+end
--
2.43.0
