[gcc r12-7305] Fortran: improve check of pointer initialization in DATA statements

[Harald Anlauf]

https://gcc.gnu.org/g:e49508ac6b36adb8a2056c5a1fb6e0178de2439d

commit r12-7305-ge49508ac6b36adb8a2056c5a1fb6e0178de2439d
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Wed Feb 9 21:54:29 2022 +0100

    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.

Diff:
---
 gcc/fortran/data.cc                          |  4 ++++
 gcc/fortran/gfortran.h                       |  3 +++
 gcc/testsuite/gfortran.dg/data_pointer_2.f90 | 21 +++++++++++++++++++++
 3 files changed, 28 insertions(+)

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 cb136f875f4..f8fd1ba8b95 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3897,6 +3897,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