[gcc r15-10014] Fortran: fix bogus runtime error with optional procedure argument [PR121145]

[Harald Anlauf via Gcc-cvs]

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

commit r15-10014-gd553ca787f1f9797ebe1e33fc189cc4a5220c136
Author: Harald Anlauf <anl...@gmx.de>
Date:   Fri Jul 18 21:12:03 2025 +0200

    Fortran: fix bogus runtime error with optional procedure argument [PR121145]
    
            PR fortran/121145
    
    gcc/fortran/ChangeLog:
    
            * trans-expr.cc (gfc_conv_procedure_call): Do not create pointer
            check for proc-pointer actual passed to optional dummy.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/pointer_check_15.f90: New test.
    
    (cherry picked from commit 8f9450505f8244d262f8b4ff274f113f99cdc7e2)

Diff:
---
 gcc/fortran/trans-expr.cc                      |  3 +-
 gcc/testsuite/gfortran.dg/pointer_check_15.f90 | 46 ++++++++++++++++++++++++++
 2 files changed, 48 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index a92d5cd75b67..e4cba5647c30 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8150,7 +8150,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                msg = xasprintf ("Pointer actual argument '%s' is not "
                                 "associated", e->symtree->n.sym->name);
              else if (attr.proc_pointer && !e->value.function.actual
-                      && (fsym == NULL || !fsym_attr.proc_pointer))
+                      && (fsym == NULL
+                          || (!fsym_attr.proc_pointer && !fsym_attr.optional)))
                msg = xasprintf ("Proc-pointer actual argument '%s' is not "
                                 "associated", e->symtree->n.sym->name);
              else
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_15.f90 
b/gcc/testsuite/gfortran.dg/pointer_check_15.f90
new file mode 100644
index 000000000000..13c6820be0e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_15.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-additional-options "-O -fcheck=pointer -fdump-tree-original" }
+!
+! PR fortran/121145
+! Erroneous runtime error: Proc-pointer actual argument 'ptr' is not associated
+!
+! Contributed by Federico Perini.
+
+module m
+  implicit none
+
+  abstract interface
+     subroutine fun(x)
+       real, intent(in) :: x
+     end subroutine fun
+  end interface   
+
+contains
+
+  subroutine with_fun(sub)
+    procedure(fun), optional :: sub
+    if (present(sub)) stop 1
+  end subroutine   
+
+  subroutine with_non_optional(sub)
+    procedure(fun) :: sub
+  end subroutine   
+
+end module m
+
+program p
+  use m
+  implicit none
+
+  procedure(fun), pointer :: ptr1 => null()
+  procedure(fun), pointer :: ptr2 => null()
+  
+  call with_fun()
+  call with_fun(sub=ptr1)               ! no runtime check here
+
+  if (associated (ptr2)) then
+     call with_non_optional(sub=ptr2)   ! runtime check here
+  end if
+end  
+
+! { dg-final { scan-tree-dump-times "Proc-pointer actual argument .'ptr2.'" 1 
"original" } }