https://gcc.gnu.org/g:3b276fe0d22f9052657dbbffbb8ad6f8585bd304
commit r16-1528-g3b276fe0d22f9052657dbbffbb8ad6f8585bd304
Author: Harald Anlauf <anl...@gmx.de>
Date: Sun Jun 15 21:09:28 2025 +0200
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.
Diff:
---
gcc/fortran/resolve.cc | 17 ++++++++
gcc/testsuite/gfortran.dg/allocate_with_mold_5.f90 | 51 ++++++++++++++++++++++
2 files changed, 68 insertions(+)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d09aef0a899c..5413d8f9c542 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 000000000000..f5e2fc93d0a4
--- /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
