User account creation filtered due to spam.

Bug 40593 - Proc-pointer returning function as actual argument
Summary: Proc-pointer returning function as actual argument
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.5.0
: P3 normal
Target Milestone: ---
Assignee: janus
URL:
Keywords: rejects-valid, wrong-code
Depends on:
Blocks:
 
Reported: 2009-06-29 17:29 UTC by Tobias Burnus
Modified: 2009-07-04 13:01 UTC (History)
2 users (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2009-07-04 11:40:36


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description Tobias Burnus 2009-06-29 17:29:06 UTC
Here, the proc-pointer result is passed as actual argument to a procedure which does not want to have the pointer but the pointer target.

There are two problems: The first program shows wrong code:
  sub (void (*<T3c5>) (integer(kind=4) &) f)
but passed is:
    void (*<T3c5>) (integer(kind=4) &) D.1559;
    D.1559 = getptr ();
    sub (&D.1559);
Result: A segmentation fault.

The second program shows that the argument conformance checking goes wrong:
  call sub(getPtr())
           1
Error: Type mismatch in argument 'f' at (1); passed UNKNOWN to INTEGER(4)


Problem found when writing a test case for PR 40580. Please add also an -fcheck=pointer test (assuming that PR 40580 gets checked in earlier) - I have a test there, but it needs to be enabled


!------------ ONE -------------------
module m
contains
  subroutine func(a)
    integer :: a
    a = 42
  end subroutine func
end module m

program test
  use m
  implicit none
  call sub(getPtr())
contains
  subroutine sub(f)
    procedure(func) :: f
    integer :: a
    call f(a)
    if (a /= 42)  call abort()
    print *, a
  end subroutine sub
  function getPtr()
    procedure(func), pointer :: getPtr
    getPtr => func
  end function getPtr
end program test


!------------ TWO -------------------
module m
contains
  function func()
    integer :: func
    func = 42
  end function func
end module m

program test
  use m
  implicit none
  procedure(integer), pointer :: ptr
  call sub(getPtr())
contains
  subroutine sub(f)
    procedure(integer) :: f
    if (f() /= 42)  call abort()
    print *, f()
  end subroutine sub
  function getPtr()
    procedure(func), pointer :: getPtr
    getPtr => func
  end function getPtr
end program test
Comment 1 Tobias Burnus 2009-06-29 17:40:11 UTC
Hmm, something else goes wrong, too, my fix for PR 40580 does not generate a check (for procpointer results), it does for pointer function results and it does for normal proc pointers. Thus, it either gets fixed automatically with this bug, or one needs to spend some time on finding out why it does not work.
Comment 2 Tobias Burnus 2009-06-29 21:00:47 UTC
-fcheck=pointer (remaining issues/features) is now tracked at PR 40593
Comment 3 Tobias Burnus 2009-06-30 05:21:55 UTC
> -fcheck=pointer (remaining issues/features) is now tracked at PR 40593
Ignore - that should have gone to PR 40580
Comment 4 janus 2009-07-01 08:35:59 UTC
The second example in comment #0 is fixed by the following patch:

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 149129)
+++ gcc/fortran/resolve.c	(working copy)
@@ -1828,7 +1828,10 @@ resolve_specific_f0 (gfc_symbol *sym, gf
 found:
   gfc_procedure_use (sym, &expr->value.function.actual, &expr->where);
 
-  expr->ts = sym->ts;
+  if (sym->result)
+    expr->ts = sym->result->ts;
+  else
+    expr->ts = sym->ts;
   expr->value.function.name = sym->name;
   expr->value.function.esym = sym;
   if (sym->as != NULL)
Comment 5 janus 2009-07-01 08:39:36 UTC
Related problem:

module m
contains
  subroutine func()
    print *,"42"
  end subroutine func
end module m

program test
  use m
  implicit none
  call sub(getPtr())
contains
  subroutine sub(f)
    procedure(func),pointer :: f
    call f()
  end subroutine sub
  function getPtr()
    procedure(func), pointer :: getPtr
    getPtr => func
  end function getPtr
end program test


is rejected with:

  call sub(getPtr())
           1
Error: Expected a procedure pointer for argument 'f' at (1)
Comment 6 janus 2009-07-01 08:54:59 UTC
The compile-time error in comment #5 is fixed by:

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 149129)
+++ gcc/fortran/interface.c	(working copy)
@@ -1911,7 +1911,10 @@ compare_actual_formal (gfc_actual_arglis
       /* Satisfy 12.4.1.3 by ensuring that a procedure pointer actual argument
 	 is provided for a procedure pointer formal argument.  */
       if (f->sym->attr.proc_pointer
-	  && !(a->expr->symtree->n.sym->attr.proc_pointer
+	  && !((a->expr->expr_type == EXPR_VARIABLE
+		&& a->expr->symtree->n.sym->attr.proc_pointer)
+	       || (a->expr->expr_type == EXPR_FUNCTION
+		   && a->expr->symtree->n.sym->result->attr.proc_pointer)
 	       || is_proc_ptr_comp (a->expr, NULL)))
 	{
 	  if (where)


However, it still gives a runtime segfault due to:

    void (*<T63>) (void) D.1556;
    D.1556 = getptr ();
    sub (&&D.1556);
Comment 7 janus 2009-07-04 11:40:36 UTC
Mine. Patch:

http://gcc.gnu.org/ml/fortran/2009-07/msg00016.html
Comment 8 janus 2009-07-04 12:28:58 UTC
Subject: Bug 40593

Author: janus
Date: Sat Jul  4 12:28:43 2009
New Revision: 149227

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=149227
Log:
2009-07-04  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40593
	* interface.c (compare_actual_formal): Take care of proc-pointer-valued
	functions as actual arguments.
	* trans-expr.c (gfc_conv_procedure_call): Ditto.
	* resolve.c (resolve_specific_f0): Use the correct ts.


2009-07-04  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40593
	* gfortran.dg/proc_ptr_result_6.f90: New.


Added:
    trunk/gcc/testsuite/gfortran.dg/proc_ptr_result_6.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/interface.c
    trunk/gcc/fortran/resolve.c
    trunk/gcc/fortran/trans-expr.c
    trunk/gcc/testsuite/ChangeLog

Comment 9 janus 2009-07-04 13:01:09 UTC
Fixed with r149227. Closing.