diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 3 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pointer_check_15.f90 | 46 |
2 files changed, 48 insertions, 1 deletions
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 082987f..6fa52d0 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -8159,7 +8159,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 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" } } |