GCC Bugzilla has been upgraded from version 4.4.9 to 5.0rc3. If you see any problem, please report it to bug 64968.
Bug 47240 - [F03] segfault with procedure pointer component
Summary: [F03] segfault with procedure pointer component
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.6.0
: P3 normal
Target Milestone: ---
Assignee: janus
URL:
Keywords: wrong-code
Depends on:
Blocks:
 
Reported: 2011-01-10 08:47 UTC by Martien Hulsen
Modified: 2011-01-19 08:34 UTC (History)
3 users (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2011-01-10 09:23:36


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description Martien Hulsen 2011-01-10 08:47:10 UTC
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
Comment 1 Tobias Burnus 2011-01-10 09:10:34 UTC
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);
Comment 2 janus 2011-01-10 09:23:36 UTC
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).
Comment 3 janus 2011-01-10 20:27:29 UTC
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.
Comment 4 janus 2011-01-10 21:50:21 UTC
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;
Comment 5 janus 2011-01-11 11:48:52 UTC
(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.
Comment 6 Dominique d'Humieres 2011-01-11 14:21:26 UTC
> > Index: gcc/fortran/resolve.c
> > ...
> >      continue;
>
> ... this produces loads of regressions.

Confirmed;-(
Comment 7 janus 2011-01-11 14:43:52 UTC
(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;
Comment 8 Dominique d'Humieres 2011-01-11 21:38:46 UTC
(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
Comment 9 janus 2011-01-12 20:00:37 UTC
(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 ...
Comment 10 Dominique d'Humieres 2011-01-12 20:59:31 UTC
> 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).
Comment 11 Tobias Burnus 2011-01-12 21:49:23 UTC
(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.)
Comment 12 Dominique d'Humieres 2011-01-12 22:18:35 UTC
> 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.
Comment 13 Jerry DeLisle 2011-01-13 05:28:03 UTC
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.
Comment 14 Dominique d'Humieres 2011-01-13 18:43:27 UTC
> 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.
Comment 15 janus 2011-01-18 22:40:38 UTC
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
Comment 16 janus 2011-01-18 23:09:31 UTC
Fixed with r168973. Closing.
Comment 17 Martien Hulsen 2011-01-19 08:34:21 UTC
(In reply to comment #16)
> Fixed with r168973.

Indeed. Thanks. All my test problems for my FEM code run correctly now with gfortran.