aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2025-07-18 21:12:03 +0200
committerHarald Anlauf <anlauf@gmx.de>2025-07-18 21:12:03 +0200
commit8f9450505f8244d262f8b4ff274f113f99cdc7e2 (patch)
tree5f739dfc7e71bdc948fff151f33999de6da452be /gcc/testsuite
parentf069bacbf5d0f14974b8f180588bac51f9ef1a43 (diff)
downloadgcc-master.zip
gcc-master.tar.gz
gcc-master.tar.bz2
Fortran: fix bogus runtime error with optional procedure argument [PR121145]HEADtrunkmaster
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.
Diffstat (limited to 'gcc/testsuite')
-rw-r--r--gcc/testsuite/gfortran.dg/pointer_check_15.f9046
1 files changed, 46 insertions, 0 deletions
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 0000000..13c6820
--- /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" } }