diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2022-02-09 21:54:29 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2022-02-20 22:34:21 +0100 |
| commit | e49508ac6b36adb8a2056c5a1fb6e0178de2439d (patch) | |
| tree | 048885f0da1273e10c776209d068ff9e7288499d /gcc/fortran | |
| parent | 1f96b5eeef10e19a6b44152e418f252fa676e292 (diff) | |
| download | gcc-e49508ac6b36adb8a2056c5a1fb6e0178de2439d.zip gcc-e49508ac6b36adb8a2056c5a1fb6e0178de2439d.tar.gz gcc-e49508ac6b36adb8a2056c5a1fb6e0178de2439d.tar.bz2 | |
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.
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/data.cc | 4 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 3 |
2 files changed, 7 insertions, 0 deletions
diff --git a/gcc/fortran/data.cc b/gcc/fortran/data.cc index f7c9143..7a5866f 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 cb136f8..f8fd1ba 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 */ |