re PR fortran/84924 (Erroneous error in C_F_POINTER)

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-25  Seth Johnson <johnsonsr@ornl.gov>
	Dominique d'Humieres  <dominiq@gcc.gnu.org>

	PR fortran/84924
	* gfortran.dg/scalar_pointer_1.f90: New test.


Co-Authored-By: Dominique d'Humieres <dominiq@gcc.gnu.org>

From-SVN: r258843

gcc/fortran/ChangeLog

+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>
 

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);
 

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/scalar_pointer_1.f90

+! { 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