Dear all,
as we did not properly check the initialization of pointers in
DATA statements for valid initial data targets, we could either
ICE or generate wrong code. Testcase based on Gerhard's, BTW.
The attached patch adds a check in gfc_assign_data_value by
calling gfc_check_pointer_assign, as the latter did not get
called otherwise.
Along the course I introduced a new macro IS_POINTER() that
should help to make the code more readable whenever we need
to check the attributes of a symbol to see whether it is a
pointer, CLASS or not. At least it may save some typing in
the future.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From c94d8f63482e810453dd188faa8396dfac397929 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Wed, 9 Feb 2022 21:54:29 +0100
Subject: [PATCH] Fortran: improve check of pointer initialization in DATA
statements
gcc/fortran/ChangeLog:
PR fortran/77693
* data.cc (gfc_assign_data_value): If a variable in a data
statement has the POINTER attribute, check for allowed initial
data target that is compatible with pointer assignment.
* gfortran.h (IS_POINTER): New macro.
gcc/testsuite/ChangeLog:
PR fortran/77693
* gfortran.dg/data_pointer_2.f90: New test.
---
gcc/fortran/data.cc | 4 ++++
gcc/fortran/gfortran.h | 3 +++
gcc/testsuite/gfortran.dg/data_pointer_2.f90 | 21 ++++++++++++++++++++
3 files changed, 28 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/data_pointer_2.f90
diff --git a/gcc/fortran/data.cc b/gcc/fortran/data.cc
index f7c91437439..7a5866f3c28 100644
--- a/gcc/fortran/data.cc
+++ b/gcc/fortran/data.cc
@@ -618,6 +618,10 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
gfc_convert_type (expr, &lvalue->ts, 0);
}
+ if (IS_POINTER (symbol)
+ && !gfc_check_pointer_assign (lvalue, rvalue, false, true))
+ return false;
+
if (last_con == NULL)
symbol->value = expr;
else
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 993879feda4..32618c155dc 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3896,6 +3896,9 @@ bool gfc_is_finalizable (gfc_symbol *, gfc_expr **);
&& CLASS_DATA (sym) \
&& CLASS_DATA (sym)->attr.dimension \
&& !CLASS_DATA (sym)->attr.class_pointer)
+#define IS_POINTER(sym) \
+ (sym->ts.type == BT_CLASS && sym->attr.class_ok && CLASS_DATA (sym) \
+ ? CLASS_DATA (sym)->attr.class_pointer : sym->attr.pointer)
/* frontend-passes.cc */
diff --git a/gcc/testsuite/gfortran.dg/data_pointer_2.f90 b/gcc/testsuite/gfortran.dg/data_pointer_2.f90
new file mode 100644
index 00000000000..e1677d1c3fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_pointer_2.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-O -g" }
+! PR fortran/77693 - ICE in rtl_for_decl_init
+! Contributed by G.Steinmetz
+
+program p
+ implicit none
+ complex, target :: y = (1.,2.)
+ complex, target :: z(2) = (3.,4.)
+ complex, pointer :: a => y
+ complex, pointer :: b => z(1)
+ complex, pointer :: c, d, e
+ data c /NULL()/ ! Valid
+ data d /y/ ! Valid
+ data e /(1.,2.)/ ! { dg-error "Pointer assignment target" }
+ if (associated (a)) print *, a% re
+ if (associated (b)) print *, b% im
+ if (associated (c)) print *, c% re
+ if (associated (d)) print *, d% im
+ if (associated (e)) print *, e% re
+end
--
2.34.1
