The following code gives a segmentation fault. module element_defs_m type tfunc_p procedure (dum_tfunc), pointer, nopass :: p => null() end type tfunc_p type coefficients_t type(tfunc_p), allocatable, dimension(:) :: tfunc1 end type coefficients_t contains function dum_tfunc ( n, x ) integer, intent(in) :: n real, intent(in), dimension(:) :: x real, dimension(n,n) :: dum_tfunc dum_tfunc = 0 end function dum_tfunc end module element_defs_m module m1 use element_defs_m contains subroutine scalar_diffusion2_elem ( coefficients) type(coefficients_t), intent(in) :: coefficients real :: coef (2,2) call evaluate_tensor_coefficient ( coefficients%tfunc1(1)%p, coef ) print *, coef end subroutine scalar_diffusion2_elem subroutine evaluate_tensor_coefficient ( tfunc, coef ) interface function tfunc ( n, x ) integer, intent(in) :: n real, intent(in), dimension(:) :: x real, dimension(n,n) :: tfunc end function tfunc end interface real, dimension(:,:), intent(out) :: coef real :: x(2)=0 coef = tfunc( n=2, x=x ) end subroutine evaluate_tensor_coefficient end module m1 program t use m1 type(coefficients_t) :: coefficients allocate(coefficients%tfunc1(1)) coefficients%tfunc1(1)%p => dum_tfunc call scalar_diffusion2_elem ( coefficients ) end program t
Seemingly the TREE generation does not honor that "coefficients%tfunc1(1)%p" is a pointer. If one has: subroutine evaluate_tensor_coefficient (tfunc, ... procedure (dum_tfunc) :: tfunc Using call evaluate_tensor_coefficient (dum_tfunc, ... ) works while call evaluate_tensor_coefficient (coefficients%tfunc1(1)%p, ...) fails. However, if one make the dummy argument a POINTER, it works: subroutine evaluate_tensor_coefficient (tfunc, ... procedure (dum_tfunc), POINTER :: tfunc when calling call evaluate_tensor_coefficient (coefficients%tfunc1(1)%p, ...) One also sees this if one looks at the dump: (*(struct tfunc_p[0:] * restrict) coefficients.tfunc1.data)[coefficients.tfunc1.offset + 1].p = dum_tfunc; Assigns the address of "dum_tfunc" to the function pointer "coefficients%tfunc1(1)%p" but in the call the again the address is taken - rather than passing the pointer as is - the first "&" should only appear if the argument is a function pointer and not just a function. evaluate_tensor_coefficient (&(*(struct tfunc_p[0:] * restrict) coefficients->tfunc1.data)[coefficients->tfunc1.offset + 1].p, &parm.17);
Confirmed. There is an additional problem with the following variant: module element_defs_m type tfunc_p procedure (dum_tfunc), pointer, nopass :: p => null() end type tfunc_p contains function dum_tfunc ( n, x ) integer, intent(in) :: n real, intent(in), dimension(:) :: x real, dimension(n,n) :: dum_tfunc dum_tfunc = 0 end function dum_tfunc end module element_defs_m program t use element_defs_m type(tfunc_p) :: tfunc1 real :: coef (2,2) tfunc1%p => dum_tfunc call evaluate_tensor_coefficient (tfunc1%p, coef ) print *, coef contains subroutine evaluate_tensor_coefficient ( tfunc, coef ) interface function tfunc ( n, x ) integer, intent(in) :: n real, intent(in), dimension(:) :: x real, dimension(n,n) :: tfunc end function tfunc end interface real, dimension(:,:), intent(out) :: coef real :: x(2)=0 coef = tfunc( n=2, x=x ) end subroutine evaluate_tensor_coefficient end program t This gives me: call evaluate_tensor_coefficient (tfunc1%p, coef ) 1 Error: Rank mismatch in argument 'tfunc' at (1) (rank-2 and scalar) (although the code is valid).
Reduced test case: type t procedure (fun), pointer, nopass :: p end type type(t) :: x x%p => fun print *, evaluate (x%p) contains real function fun () fun = 0 end function real function evaluate ( dummy ) procedure(fun) :: dummy evaluate = dummy () end function end Like the original test case, this gives a segfault at runtime. Looking at the dump, the wrong part is D.1540 = evaluate (&x.p); We should not take the address of x.p here, but just pass it as is.
The following patch fixes the wrong-code issue as well as the rejects-valid problem from comment #2: Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (revision 168617) +++ gcc/fortran/trans-expr.c (working copy) @@ -3043,8 +3043,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * && fsym->attr.flavor != FL_PROCEDURE) || (fsym->attr.proc_pointer && !(e->expr_type == EXPR_VARIABLE - && e->symtree->n.sym->attr.dummy)) - || (e->expr_type == EXPR_VARIABLE + && e->symtree->n.sym->attr.dummy)) + || (fsym->attr.proc_pointer + && e->expr_type == EXPR_VARIABLE && gfc_is_proc_ptr_comp (e, NULL)) || fsym->attr.allocatable)) { Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 168618) +++ gcc/fortran/resolve.c (working copy) @@ -4858,6 +4858,9 @@ expression_rank (gfc_expr *e) for (ref = e->ref; ref; ref = ref->next) { + if (ref->type == REF_COMPONENT) + rank = ref->u.c.component->as ? ref->u.c.component->as->rank : 0; + if (ref->type != REF_ARRAY) continue;
(In reply to comment #4) > Index: gcc/fortran/trans-expr.c > =================================================================== > --- gcc/fortran/trans-expr.c (revision 168617) > +++ gcc/fortran/trans-expr.c (working copy) > @@ -3043,8 +3043,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * > && fsym->attr.flavor != FL_PROCEDURE) > || (fsym->attr.proc_pointer > && !(e->expr_type == EXPR_VARIABLE > - && e->symtree->n.sym->attr.dummy)) > - || (e->expr_type == EXPR_VARIABLE > + && e->symtree->n.sym->attr.dummy)) > + || (fsym->attr.proc_pointer > + && e->expr_type == EXPR_VARIABLE > && gfc_is_proc_ptr_comp (e, NULL)) > || fsym->attr.allocatable)) > { This part is fine and regtests cleanly, however ... > Index: gcc/fortran/resolve.c > =================================================================== > --- gcc/fortran/resolve.c (revision 168618) > +++ gcc/fortran/resolve.c (working copy) > @@ -4858,6 +4858,9 @@ expression_rank (gfc_expr *e) > > for (ref = e->ref; ref; ref = ref->next) > { > + if (ref->type == REF_COMPONENT) > + rank = ref->u.c.component->as ? ref->u.c.component->as->rank : 0; > + > if (ref->type != REF_ARRAY) > continue; ... this produces loads of regressions.
> > Index: gcc/fortran/resolve.c > > ... > > continue; > > ... this produces loads of regressions. Confirmed;-(
(In reply to comment #5) > > Index: gcc/fortran/resolve.c > > =================================================================== > > --- gcc/fortran/resolve.c (revision 168618) > > +++ gcc/fortran/resolve.c (working copy) > > @@ -4858,6 +4858,9 @@ expression_rank (gfc_expr *e) > > > > for (ref = e->ref; ref; ref = ref->next) > > { > > + if (ref->type == REF_COMPONENT) > > + rank = ref->u.c.component->as ? ref->u.c.component->as->rank : 0; > > + > > if (ref->type != REF_ARRAY) > > continue; > > ... this produces loads of regressions. ... but the following variant doesn't: Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 168655) +++ gcc/fortran/resolve.c (working copy) @@ -4858,6 +4858,9 @@ expression_rank (gfc_expr *e) for (ref = e->ref; ref; ref = ref->next) { + if (ref->type == REF_COMPONENT && !ref->next) + rank = ref->u.c.component->as ? ref->u.c.component->as->rank : 0; + if (ref->type != REF_ARRAY) continue;
(In reply to comment #7) > > ... > > ... this produces loads of regressions. > > ... but the following variant doesn't: > ... Confirmed, however the following code [macbook] f90/bug% cat pr35971_red.f90 module other_fun use ISO_C_BINDING implicit none private ! Message to be returned by procedure pointed to ! by the C_FUNPTR character, allocatable, save :: my_message(:) ! Interface block for the procedure pointed to ! by the C_FUNPTR public abstract_fun abstract interface function abstract_fun(x) use ISO_C_BINDING import my_message implicit none integer(C_INT) x(:) character(size(my_message),C_CHAR) abstract_fun(size(x)) end function abstract_fun end interface contains ! Procedure to store the message and get the C_FUNPTR function gp(message) bind(C,name='BlAh') ! procedure(abstract_fun) make_mess character(kind=C_CHAR) message(*) type(C_FUNPTR) gp integer(C_INT64_T) i i = 1 do while(message(i) /= C_NULL_CHAR) i = i+1 end do my_message = message(int(1,kind(i)):i-1) gp = get_funloc(make_mess,aux) ! gp = aux(make_mess) end function gp ! Intermediate procedure to pass the function and get ! back the C_FUNPTR function get_funloc(x,y) procedure(abstract_fun) x type(C_FUNPTR) y external y type(C_FUNPTR) get_funloc get_funloc = y(x) end function get_funloc ! Procedure to convert the function to C_FUNPTR function aux(x) interface subroutine x() bind(C) end subroutine x end interface type(C_FUNPTR) aux aux = C_FUNLOC(x) end function aux ! Procedure pointed to by the C_FUNPTR function make_mess(x) integer(C_INT) x(:) character(size(my_message),C_CHAR) make_mess(size(x)) make_mess = transfer(my_message,make_mess(1)) end function make_mess end module other_fun end gives at -O2 and above [macbook] f90/bug% gfc -O2 pr35971_red.f90 pr35971_red.f90: In function 'gp': pr35971_red.f90:67:0: error: non-trivial conversion at assignment void (*<T64>) (void) void (*<T49d>) (struct array1_unknown &, integer(kind=4), struct array1_integer(kind=4) & restrict) __result_gp_72 = make_mess; pr35971_red.f90:67:0: internal compiler error: verify_stmts failed
(In reply to comment #8) > [macbook] f90/bug% gfc -O2 pr35971_red.f90 > pr35971_red.f90: In function 'gp': > pr35971_red.f90:67:0: error: non-trivial conversion at assignment > void (*<T64>) (void) > void (*<T49d>) (struct array1_unknown &, integer(kind=4), struct > array1_integer(kind=4) & restrict) > __result_gp_72 = make_mess; > > pr35971_red.f90:67:0: internal compiler error: verify_stmts failed sorry, I can not reproduce this at r168655 (plus patch from comment #7), at least not on x86_64-unknown-linux-gnu. Do you only get this error with the patch, or also with a clean trunk? I would expect that my patch should not have any impact on your test case ...
> sorry, I can not reproduce this at r168655 (plus patch from comment #7), at > least not on x86_64-unknown-linux-gnu. Do you only get this error with the > patch, or also with a clean trunk? I would expect that my patch should not have > any impact on your test case ... I am rebuilding a clean tree with only the following patch diff -up ../_clean/gcc/fortran/resolve.c gcc/fortran/resolve.c --- ../_clean/gcc/fortran/resolve.c 2011-01-09 22:13:56.000000000 +0100 +++ gcc/fortran/resolve.c 2011-01-12 21:49:39.000000000 +0100 @@ -4858,6 +4858,9 @@ expression_rank (gfc_expr *e) for (ref = e->ref; ref; ref = ref->next) { + if (ref->type == REF_COMPONENT && !ref->next) + rank = ref->u.c.component->as ? ref->u.c.component->as->rank : 0; + if (ref->type != REF_ARRAY) continue; diff -up ../_clean/gcc/fortran/trans-expr.c gcc/fortran/trans-expr.c --- ../_clean/gcc/fortran/trans-expr.c 2011-01-08 20:18:07.000000000 +0100 +++ gcc/fortran/trans-expr.c 2011-01-12 21:49:39.000000000 +0100 @@ -3044,7 +3044,8 @@ gfc_conv_procedure_call (gfc_se * se, gf || (fsym->attr.proc_pointer && !(e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.dummy)) - || (e->expr_type == EXPR_VARIABLE + || (fsym->attr.proc_pointer + && e->expr_type == EXPR_VARIABLE && gfc_is_proc_ptr_comp (e, NULL)) || fsym->attr.allocatable)) { (your patch for trans-expr.c does not apply cleanly with a copy&past from safari, so I hope I got it right).
(In reply to comment #9) > > pr35971_red.f90:67:0: internal compiler error: verify_stmts failed I can reproduce this with a clean trunk on x86-64-linux with both -m32 and -m64. > I can not reproduce this at r168655 (plus patch from comment #7) How do you configure gfortran? (I did a full bootstrap and did *not* use --enable-checking=release.) * * * Regarding the test case: I think it is invalid: function aux(x) interface subroutine x() bind(C) end subroutine x end interface but you pass as actual argument the function (!) "make_mess" which take also arguments to "aux". (In get_funloc everything is still fine - the actual argument has the proper type: "abstract_fun".) I believe that the argument mismatch is invalid. And the compiler has no chance to detect this at (front-end) compile time as you use a dummy "external y" instead of the explicit interface of "aux". Like always: A compiler can tolerate to a certain extend argument mismatches - but especially with higher optimization values, it trusts the user that (s)he knows what he is doing - and that (s)he stays within what the standard allows. (The same is true for alias analysis.)
> I can reproduce this with a clean trunk on x86-64-linux with both -m32 and > -m64. I confirm that the ICE is not due to the patch. > Regarding the test case: I think it is invalid: I have never said that it was valid (it is not mine and you have probably recognized the style!-). Nevertheless there was no ICE at revision 168625 (I saw it at revision 168653) and even invalid codes should not give ICE.
Confirmed at 168737 $ gfc -c -O2 red.f90 red.f90: In function ‘gp’: red.f90:67:0: error: non-trivial conversion at assignment void (*<T64>) (void) void (*<T496>) (struct array1_unknown &, integer(kind=4), struct array1_integer(kind=4) & restrict) __result_gp_72 = make_mess; red.f90:67:0: internal compiler error: verify_stmts failed Looks like an optimization bug.
> I have never said that it was valid (it is not mine and you have probably > recognized the style!-). Nevertheless there was no ICE at revision 168625 (I > saw it at revision 168653) and even invalid codes should not give ICE. I did not read my logs correctly!-(the ICE is due to revision 168665, see pr47281). Note that otherwise the patch summarized in comment #10 works as advertised.
Author: janus Date: Tue Jan 18 22:40:33 2011 New Revision: 168973 URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=168973 Log: 2011-01-18 Janus Weil <janus@gcc.gnu.org> PR fortran/47240 * resolve.c (expression_rank): Fix rank of procedure poiner components. * trans-expr.c (gfc_conv_procedure_call): Take care of procedure pointer components as actual arguments. 2011-01-18 Janus Weil <janus@gcc.gnu.org> PR fortran/47240 * gfortran.dg/proc_ptr_comp_29.f90: New. Added: trunk/gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90 Modified: trunk/gcc/fortran/ChangeLog trunk/gcc/fortran/resolve.c trunk/gcc/fortran/trans-expr.c trunk/gcc/testsuite/ChangeLog
Fixed with r168973. Closing.
(In reply to comment #16) > Fixed with r168973. Indeed. Thanks. All my test problems for my FEM code run correctly now with gfortran.