diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/check.c | 2 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/scalar_pointer_1.f90 | 36 |
4 files changed, 50 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f21f7c7..4d93c55 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2018-03-25 Seth Johnson <johnsonsr@ornl.gov> + Dominique d'Humieres <dominiq@gcc.gnu.org> + + PR fortran/84924 + * check.c (gfc_check_c_f_pointer): Allow scalar noninteroperable + scalar derived type with -std=f2003 and -std=f2008. + 2018-03-24 Jerry DeLisle <jvdelisle@gcc.gnu.org> Dominique d'Humieres <dominiq@gcc.gnu.org> diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 23b1964..83bd004 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -4749,7 +4749,7 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape) return false; } - if (!is_c_interoperable (fptr, &msg, false, true)) + if (fptr->rank > 0 && !is_c_interoperable (fptr, &msg, false, true)) return gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable array FPTR " "at %L to C_F_POINTER: %s", &fptr->where, msg); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 004c44c..8b462a5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-03-25 Seth Johnson <johnsonsr@ornl.gov> + Dominique d'Humieres <dominiq@gcc.gnu.org> + + PR fortran/84924 + * gfortran.dg/scalar_pointer_1.f90: New test. + 2018-03-25 Tom de Vries <tom@codesourcery.com> * gcc.dg/tree-ssa/vrp104.c: Make scan-tree-dump-times pattern more diff --git a/gcc/testsuite/gfortran.dg/scalar_pointer_1.f90 b/gcc/testsuite/gfortran.dg/scalar_pointer_1.f90 new file mode 100644 index 0000000..d421f38 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/scalar_pointer_1.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } +! PR fortran/84924 +! Testcase contributed by Seth Johnson <johnsonsr@ornl.gov> +! +module ftest + use ISO_C_BINDING + implicit none + + type :: Cls + end type + + type :: ClsHandle + class(Cls), pointer :: ptr + end type +contains + subroutine to_ptr(c, p) + use ISO_C_BINDING + class(Cls), intent(in), target :: c + type(C_PTR), intent(out) :: p + type(ClsHandle), pointer :: handle + allocate(handle) + handle%ptr => c + p = c_loc(handle) + end subroutine + + subroutine from_ptr(p, c) + use ISO_C_BINDING + type(C_PTR), intent(in) :: p + class(Cls), intent(out), pointer :: c + type(ClsHandle), pointer :: handle + call c_f_pointer(cptr=p, fptr=handle) + c => handle%ptr + deallocate(handle) + end subroutine +end module |