Dear all,
the attached patch is the result of my attempts to fix an ICE when
compiling gfortran.dg/proc_ptr_52.f90 with -fcheck=all. While
trying to reduce this, I found several oddities with functions
returning class(*), pointer that ICE'd too.
The original ICE in the PR turned out to be a bug in the pointer
checking code when passing a procedure pointer to a CLASS procedure
dummy that tried to access the container of the procedure pointer.
I believe that this should not be done, and one should only check
that the procedure pointer is not null.
I am not too experienced which class-valued functions, so if any
of the experts (Paul, Andre', ...) could have a look?
(After fixing the issue with -fcheck=pointer, I ran into a bogus
error with -Wexternal-argument-mismatch for the same testcase.
This is now pr119928.)
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Cheers,
Harald
From a6ec26a7d7a92a5e2cefedf08a4616060783050e Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Thu, 24 Apr 2025 21:28:35 +0200
Subject: [PATCH] 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.
---
gcc/fortran/trans-decl.cc | 6 ++--
gcc/fortran/trans-expr.cc | 10 ++++---
gcc/testsuite/gfortran.dg/proc_ptr_52.f90 | 1 +
gcc/testsuite/gfortran.dg/proc_ptr_57.f90 | 36 +++++++++++++++++++++++
4 files changed, 46 insertions(+), 7 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_57.f90
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index ee48a820f28..43bd7be54cb 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -8079,13 +8079,13 @@ gfc_generate_function_code (gfc_namespace * ns)
|| sym->result->ts.u.derived->attr.alloc_comp
|| sym->result->ts.u.derived->attr.pointer_comp))
|| (sym->result->ts.type == BT_CLASS
- && (CLASS_DATA (sym)->attr.allocatable
- || CLASS_DATA (sym)->attr.class_pointer
+ && (CLASS_DATA (sym->result)->attr.allocatable
+ || CLASS_DATA (sym->result)->attr.class_pointer
|| CLASS_DATA (sym->result)->attr.alloc_comp
|| CLASS_DATA (sym->result)->attr.pointer_comp))))
{
artificial_result_decl = true;
- result = gfc_get_fake_result_decl (sym, 0);
+ result = gfc_get_fake_result_decl (sym->result, 0);
}
if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 19e5669b9ee..8d9448eb9b6 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. */
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_52.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_52.f90
index cb7cf7040a9..421d2479cd6 100644
--- a/gcc/testsuite/gfortran.dg/proc_ptr_52.f90
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_52.f90
@@ -1,4 +1,5 @@
! { dg-do run }
+! { dg-additional-options "-fcheck=pointer" }
!
! Test the fix for PRs93924 & 93925.
!
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_57.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_57.f90
new file mode 100644
index 00000000000..7ecb88f172c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_57.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-additional-options "-fcheck=pointer" }
+!
+! PR fortran/102900
+
+module cs
+ implicit none
+ interface
+ function classStar_map_ifc() result(y)
+ import
+ class(*), pointer :: y
+ end function classStar_map_ifc
+ end interface
+
+contains
+
+ function selector()
+ procedure(classStar_map_ifc), pointer :: selector
+ selector => NULL()
+ end function selector
+
+ function selector_result() result(f)
+ procedure(classStar_map_ifc), pointer :: f
+ f => NULL()
+ end function selector_result
+
+ function fun(x) result(y)
+ class(*), pointer :: y
+ class(*), target, intent(in) :: x
+ select type (x)
+ class default
+ y => null()
+ end select
+ end function fun
+
+end module cs
--
2.43.0
