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 --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 7adbf958aec12381e356526967fe528c947c56bc..1a4799dac78f91900237003fa3714c91ed1ef240 100644 (file)
--- 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 a5e951ad1021f4d2da03ae531d9f68a5b8584c60..04bd95559eadd23db456689f84fd7876368f3ef5 100644 (file)
--- 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 (file)
index 0000000..ce53eef
--- /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