Dear all,

the attached patch enhances the checking of pointer targets in structure
constructors to catch the following invalid cases (before we ICE :)
- different rank
- vector subscript of target

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

Thanks,
Harald

From 118a6c3247bb30ef932341cec3ca15e2c6304b69 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Mon, 10 Feb 2025 18:47:45 +0100
Subject: [PATCH] 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.
---
 gcc/fortran/resolve.cc                        | 12 ++++++++++-
 .../derived_constructor_comps_2.f90           |  4 ++--
 .../derived_constructor_comps_8.f90           | 20 +++++++++++++++++++
 3 files changed, 33 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/derived_constructor_comps_8.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 7adbf958aec..1a4799dac78 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 a5e951ad102..04bd95559ea 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 00000000000..ce53eef7503
--- /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
-- 
2.43.0

Reply via email to