diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2025-04-24 21:28:35 +0200 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2025-04-25 18:33:04 +0200 |
| commit | cc8d86ee4680d56eefeb76a8f2f752282e2631e3 (patch) | |
| tree | 8d91ce6609dbb8796fd94543084b51f378de3b6f /gcc/fortran/trans-expr.cc | |
| parent | 44e31eb265ba1984638908466a88095744a88709 (diff) | |
| download | gcc-cc8d86ee4680d56eefeb76a8f2f752282e2631e3.zip gcc-cc8d86ee4680d56eefeb76a8f2f752282e2631e3.tar.gz gcc-cc8d86ee4680d56eefeb76a8f2f752282e2631e3.tar.bz2 | |
Fortran: fix procedure pointer handling with -fcheck=pointer [PR102900]
PR fortran/102900
gcc/fortran/ChangeLog:
* trans-decl.cc (gfc_generate_function_code): Use sym->result
when generating fake result decl for functions returning
allocatable or pointer results.
* trans-expr.cc (gfc_conv_procedure_call): When checking the
pointer status of an actual argument passed to a non-allocatable,
non-pointer dummy which is of type CLASS, do not check the
class container of the actual if it is just a procedure pointer.
(gfc_trans_pointer_assignment): Fix treatment of assignment to
NULL of a procedure pointer.
gcc/testsuite/ChangeLog:
* gfortran.dg/proc_ptr_52.f90: Add -fcheck=pointer to options.
* gfortran.dg/proc_ptr_57.f90: New test.
Diffstat (limited to 'gcc/fortran/trans-expr.cc')
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 19e5669b..8d9448e 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -8145,7 +8145,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, goto end_pointer_check; tmp = parmse.expr; - if (fsym && fsym->ts.type == BT_CLASS) + if (fsym && fsym->ts.type == BT_CLASS && !attr.proc_pointer) { if (POINTER_TYPE_P (TREE_TYPE (tmp))) tmp = build_fold_indirect_ref_loc (input_location, tmp); @@ -10912,9 +10912,11 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_init_se (&lse, NULL); /* Usually testing whether this is not a proc pointer assignment. */ - non_proc_ptr_assign = !(gfc_expr_attr (expr1).proc_pointer - && expr2->expr_type == EXPR_VARIABLE - && expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE); + non_proc_ptr_assign + = !(gfc_expr_attr (expr1).proc_pointer + && ((expr2->expr_type == EXPR_VARIABLE + && expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE) + || expr2->expr_type == EXPR_NULL)); /* Check whether the expression is a scalar or not; we cannot use expr1->rank as it can be nonzero for proc pointers. */ |