From 4ea60a393eee13a0a7715b7c8134e2115195c7f7 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sat, 9 Mar 2019 19:21:24 +0000 Subject: [PATCH] re PR fortran/71544 (gfortran compiler optimization bug when dealing with c-style pointers) 2019-03-09 Thomas Koenig 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-03-09 Thomas Koenig PR fortran/71544 * gfortran.dg/c_ptr_tests_19.f90: New test. From-SVN: r269532 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/trans-types.c | 6 ++-- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/c_ptr_tests_19.f90 | 36 ++++++++++++++++++++ 4 files changed, 52 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/c_ptr_tests_19.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 40b3a3247f8..785c7313eda 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2019-03-09 Thomas Koenig + + 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-03-09 Janus Weil PR fortran/84504 diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 58102bafed8..9ae516bb666 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1176,7 +1176,8 @@ gfc_typenode_for_spec (gfc_typespec * spec, int codim) { 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'; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9b8655aceea..b1714e44109 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-03-09 Thomas Koenig + + PR fortran/71544 + * gfortran.dg/c_ptr_tests_19.f90: New test. + 2019-03-09 John David Anglin * gnat.dg/debug11.adb: Skip on 32-bit hppa*-*-hpux*. diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_19.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_19.f90 new file mode 100644 index 00000000000..2cb0b183c88 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_19.f90 @@ -0,0 +1,36 @@ +! { 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) + if (val /= 100) stop 1 +end program init_fails -- 2.30.2