Fortran: character length of pointer assignments in structure constructors

gcc/fortran/ChangeLog:

	PR fortran/50549
	* resolve.cc (resolve_structure_cons): Reject pointer assignments
	of character with different lengths in structure constructor.

gcc/testsuite/ChangeLog:

	PR fortran/50549
	* gfortran.dg/char_pointer_assign_7.f90: New test.

2 files changed, 50 insertions, 1 deletions

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 5522be7..2907677 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -1375,11 +1375,22 @@ resolve_structure_cons (gfc_expr *expr, int init)
 	  && comp->ts.u.cl->length->expr_type == EXPR_CONSTANT
 	  && cons->expr->ts.u.cl && cons->expr->ts.u.cl->length
 	  && cons->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
-	  && cons->expr->rank != 0
 	  && mpz_cmp (cons->expr->ts.u.cl->length->value.integer,
 		      comp->ts.u.cl->length->value.integer) != 0)
 	{
+	  if (comp->attr.pointer)
+	    {
+	      HOST_WIDE_INT la, lb;
+	      la = gfc_mpz_get_hwi (comp->ts.u.cl->length->value.integer);
+	      lb = gfc_mpz_get_hwi (cons->expr->ts.u.cl->length->value.integer);
+	      gfc_error ("Unequal character lengths (%wd/%wd) for pointer "
+			 "component %qs in constructor at %L",
+			 la, lb, comp->name, &cons->expr->where);
+	      t = false;
+	    }
+
 	  if (cons->expr->expr_type == EXPR_VARIABLE
+	      && cons->expr->rank != 0
 	      && cons->expr->symtree->n.sym->attr.flavor == FL_PARAMETER)
 	    {
 	      /* Wrap the parameter in an array constructor (EXPR_ARRAY)
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90
new file mode 100644
index 0000000..08bdf17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! PR fortran/50549 - should reject pointer assignments of different lengths
+! in structure constructors
+
+program test
+  implicit none
+  type t
+     character(2), pointer ::  p2
+  end type t
+  type t2
+     character(2), pointer ::  p(:)
+  end type t2
+  type td
+     character(:), pointer ::  pd
+  end type td
+  interface
+     function f1 ()
+       character(1), pointer :: f1
+     end function f1
+     function f2 ()
+       character(2), pointer :: f2
+     end function f2
+  end interface
+
+  character(1),    target  ::  p1
+  character(1),    pointer ::  q1(:)
+  character(2),    pointer ::  q2(:)
+  type(t)  :: u
+  type(t2) :: u2
+  type(td) :: v
+  u  = t(p1)    ! { dg-error "Unequal character lengths" }
+  u  = t(f1())  ! { dg-error "Unequal character lengths" }
+  u  = t(f2())  ! OK
+  u2 = t2(q1)   ! { dg-error "Unequal character lengths" }
+  u2 = t2(q2)   ! OK
+  v  = td(p1)   ! OK
+  v  = td(f1()) ! OK
+end