Hello world,

the attached patch fixes a wrong-code bug for gfortran where pointers
were not marked as escaping.  A C_PTR can be stashed away and reused
later (at least as long as the variable it points to remains active).

This is not a regression, but IMHO a bad wrong-code bug. The chances
of this patch introducing regressions are really, really low.

Regression-tested.  OK for trunk?

Regards

        Thomas

2019-02-29  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/71544
* trans-types.c (gfc_typenode_for_spec) Set ts->is_c_interop of C_PTR and
        C_FUNPTR.
(create_fn_spec): Mark argument as escaping if ts->is_c_interop is set.

2019-02-29  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/71544
        * gfortran.dg/c_ptr_tests_19.f90: New test.
Index: trans-types.c
===================================================================
--- trans-types.c	(Revision 269260)
+++ trans-types.c	(Arbeitskopie)
@@ -1176,7 +1176,8 @@ gfc_typenode_for_spec (gfc_typespec * spec, int co
         {
           spec->type = BT_INTEGER;
           spec->kind = gfc_index_integer_kind;
-          spec->f90_type = BT_VOID;
+	  spec->f90_type = BT_VOID;
+	  spec->is_c_interop = 1;  /* Mark as escaping later.  */
         }
       break;
     case BT_VOID:
@@ -2957,7 +2958,8 @@ create_fn_spec (gfc_symbol *sym, tree fntype)
 		    || f->sym->ts.u.derived->attr.pointer_comp))
 	    || (f->sym->ts.type == BT_CLASS
 		&& (CLASS_DATA (f->sym)->ts.u.derived->attr.proc_pointer_comp
-		    || CLASS_DATA (f->sym)->ts.u.derived->attr.pointer_comp)))
+		    || CLASS_DATA (f->sym)->ts.u.derived->attr.pointer_comp))
+	    || (f->sym->ts.type == BT_INTEGER && f->sym->ts.is_c_interop))
 	  spec[spec_len++] = '.';
 	else if (f->sym->attr.intent == INTENT_IN)
 	  spec[spec_len++] = 'r';
! { dg-do run }

! PR 71544 - this failed with some optimization options due to a
! pointer not being marked as escaping.

module store_cptr
    use, intrinsic :: iso_c_binding
    implicit none
    public
    type(c_ptr), save :: cptr
end module store_cptr

subroutine init()
    use, intrinsic :: iso_c_binding
    implicit none
    integer(c_int), pointer :: a
    allocate(a)
    call save_cptr(c_loc(a))
    a = 100
end subroutine init

subroutine save_cptr(cptr_in)
    use store_cptr
    implicit none
    type(c_ptr), intent(in) :: cptr_in
    cptr = cptr_in
end subroutine save_cptr

program init_fails
    use store_cptr
    implicit none
    integer(c_int), pointer :: val
    call init()
    call c_f_pointer(cptr,val)
    print *,'The following line should print 100'
    print *,val
end program init_fails

Reply via email to