The attached patch has a comment that explains what is going on. Bootstrapped and regtested on FC23/x86_64 - OK for trunk and 7-branch?
Paul 2017-10-17 Paul Thomas <pa...@gcc.gnu.org> PR fortran/82550 * expr.c (gfc_check_pointer_assign): A use associated procedure target in a submodule must have the 'use_assoc' attribute set so that the name mangling is done correctly. 2017-10-17 Paul Thomas <pa...@gcc.gnu.org> PR fortran/82550 * gfortran.dg/submodule_30.f08 : New test. -- "If you can't explain it simply, you don't understand it well enough" - Albert Einstein
Index: gcc/fortran/expr.c =================================================================== *** gcc/fortran/expr.c (revision 253748) --- gcc/fortran/expr.c (working copy) *************** gfc_check_pointer_assign (gfc_expr *lval *** 3632,3637 **** --- 3632,3645 ---- name = s2->name; } + /* Make the procedure use associated so that the middle end does + the right thing with name mangling. This undoes the reset in + parse.c(set_syms_host_assoc) and is necessary to allow the + attributes of module procedure interfaces to be changed. */ + if (s2 && s2->attr.flavor == FL_PROCEDURE + && s2->module && s2->attr.used_in_submodule) + s2->attr.use_assoc = 1; + if (s2 && s2->attr.proc_pointer && s2->ts.interface) s2 = s2->ts.interface; Index: gcc/testsuite/gfortran.dg/submodule_30.f08 =================================================================== *** gcc/testsuite/gfortran.dg/submodule_30.f08 (nonexistent) --- gcc/testsuite/gfortran.dg/submodule_30.f08 (working copy) *************** *** 0 **** --- 1,42 ---- + ! { dg-do run } + ! + ! Test the fix for PR82550 in which the reference to 'p' in 'foo' + ! was not being correctly handled. + ! + ! Contributed by Reinhold Bader <ba...@lrz.de> + ! + module m_subm_18_pos + implicit none + integer :: i = 0 + interface + module subroutine foo(fun_ptr) + procedure(p), pointer, intent(out) :: fun_ptr + end subroutine + end interface + contains + subroutine p() + i = 1 + end subroutine p + end module m_subm_18_pos + submodule (m_subm_18_pos) subm_18_pos + implicit none + contains + module subroutine foo(fun_ptr) + procedure(p), pointer, intent(out) :: fun_ptr + fun_ptr => p + end subroutine + end submodule + program p_18_pos + use m_subm_18_pos + implicit none + procedure(), pointer :: x + call foo(x) + call x() + if (i == 1) then + write(*,*) 'OK' + else + write(*,*) 'FAIL' + call abort + end if + end program p_18_pos +