https://gcc.gnu.org/g:118a6c3247bb30ef932341cec3ca15e2c6304b69
commit r15-7459-g118a6c3247bb30ef932341cec3ca15e2c6304b69
Author: Harald Anlauf <anl...@gmx.de>
Date: Mon Feb 10 18:47:45 2025 +0100
Fortran: checking of pointer targets for structure constructors [PR56423]
Check the target of a pointer component in a structure constructor for same
ranks, and that the initial-data-target does not have vector subscripts.
PR fortran/56423
gcc/fortran/ChangeLog:
* resolve.cc (resolve_structure_cons): Check rank of pointer target;
reject pointer target with vector subscripts.
gcc/testsuite/ChangeLog:
* gfortran.dg/derived_constructor_comps_2.f90: Adjust test.
* gfortran.dg/derived_constructor_comps_8.f90: New test.
Diff:
---
gcc/fortran/resolve.cc | 12 +++++++++++-
.../gfortran.dg/derived_constructor_comps_2.f90 | 4 ++--
.../gfortran.dg/derived_constructor_comps_8.f90 | 20 ++++++++++++++++++++
3 files changed, 33 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 7adbf958aec1..1a4799dac78f 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -1370,7 +1370,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
gfc_find_vtab (&cons->expr->ts);
if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank
- && (comp->attr.allocatable || cons->expr->rank))
+ && (comp->attr.allocatable || comp->attr.pointer || cons->expr->rank))
{
gfc_error ("The rank of the element in the structure "
"constructor at %L does not match that of the "
@@ -1583,6 +1583,16 @@ resolve_structure_cons (gfc_expr *expr, int init)
}
}
+ /* F2023:C770: A designator that is an initial-data-target shall ...
+ not have a vector subscript. */
+ if (comp->attr.pointer && (a.pointer || a.target)
+ && gfc_has_vector_index (cons->expr))
+ {
+ gfc_error ("Pointer assignment target at %L has a vector subscript",
+ &cons->expr->where);
+ t = false;
+ }
+
/* F2003, C1272 (3). */
bool impure = cons->expr->expr_type == EXPR_VARIABLE
&& (gfc_impure_variable (cons->expr->symtree->n.sym)
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_2.f90
b/gcc/testsuite/gfortran.dg/derived_constructor_comps_2.f90
index a5e951ad1021..04bd95559ead 100644
--- a/gcc/testsuite/gfortran.dg/derived_constructor_comps_2.f90
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_comps_2.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! Tests fix for PR29115, in which an ICE would be produced by
+! Tests fix for PR29115, in which an ICE would be produced by
! non-pointer elements being supplied to the pointer components
! in a derived type constructor.
!
@@ -9,7 +9,7 @@
integer, pointer :: bart(:)
end type homer
type(homer) :: marge
- integer :: duff_beer
+ integer :: duff_beer(1)
marge = homer (duff_beer) ! { dg-error "should be a POINTER or a TARGET" }
end
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_8.f90
b/gcc/testsuite/gfortran.dg/derived_constructor_comps_8.f90
new file mode 100644
index 000000000000..ce53eef7503e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_comps_8.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR fortran/56423
+!
+! Check constraints on pointer targets for derived type constructors
+!
+! Contributed by Tobias Burnus and Gerhard Steinmetz
+
+program p
+ integer, target :: x(3) = [7, 8, 9]
+ type t
+ integer, pointer :: a(:)
+ end type
+ type(t) :: z
+ z = t(x)
+ z = t(x(1:3))
+ z = t(x(3:1:-1))
+ z = t(x(2)) ! { dg-error "rank of the element in the structure
constructor" }
+ z = t(x([1,3])) ! { dg-error "has a vector subscript" }
+ print *, z%a
+end
