Dear all,
when assigning character pointers, we have a check for same length,
which however does not trigger for character pointers within a
structure constructor.
The attached patch extends the character checks slightly to fix
this loophole. I've verified that NAG and Crayftn behave similarly,
while Intel does not detect the length difference.
Regtested on x86_64-pc-linux-gnu.
OK for mainline? Would it be still ok for 12, or rather wait until
branching for 13?
Thanks,
Harald
From 3b88c941619bc4996ef7d4ba247086f04deb8683 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Sun, 27 Mar 2022 21:35:15 +0200
Subject: [PATCH] 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.
---
gcc/fortran/resolve.cc | 13 ++++++-
.../gfortran.dg/char_pointer_assign_7.f90 | 38 +++++++++++++++++++
2 files changed, 50 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 5522be75199..b4400a7ab8d 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)
+ {
+ long len_a, len_b;
+ len_a = mpz_get_si (comp->ts.u.cl->length->value.integer);
+ len_b = mpz_get_si (cons->expr->ts.u.cl->length->value.integer);
+ gfc_error ("Unequal character lengths (%ld/%ld) for pointer "
+ "component %qs in constructor at %L",
+ len_a, len_b, 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 00000000000..08bdf176d8b
--- /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
--
2.34.1
