Fortran: gfortran allows type(C_ptr) in I/O list

Before this patch, gfortran was accepting invalid use of
type(c_ptr) in I/O statements. The fix affects several
existing test cases so no new test case needed.

Existing tests were modified to pass by either using the
transfer function to convert to an acceptable value or
using an assignment to a like type (non-I/O).

	PR fortran/117430

gcc/fortran/ChangeLog:

	* resolve.cc (resolve_transfer): Change gfc_notify_std to
	gfc_error.

gcc/testsuite/ChangeLog:

	* gfortran.dg/c_loc_test_17.f90: Use an assignment rather than
	PRINT.
	* gfortran.dg/c_ptr_tests_10.f03: Use a transfer function.
	* gfortran.dg/c_ptr_tests_16.f90: Use an assignment.
	* gfortran.dg/c_ptr_tests_9.f03: Use a transfer function.
	* gfortran.dg/init_flag_17.f90: Likewise.
	* gfortran.dg/pr32601_1.f03: Use an assignment.

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 1a4799dac78f91900237003fa3714c91ed1ef240..3d3f117216cae43320e9810be3e7e004d5ba763d 100644 (file)
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -11824,8 +11824,8 @@ resolve_transfer (gfc_code *code)
          the component to be printed to help debugging.  */
       if (ts->u.derived->ts.f90_type == BT_VOID)
        {
-         if (!gfc_notify_std (GFC_STD_GNU, "Data transfer element at %L "
-                              "cannot have PRIVATE components", &code->loc))
+         gfc_error ("Data transfer element at %L "
+                    "cannot have PRIVATE components", &code->loc);
            return;
        }
       else if (derived_inaccessible (ts->u.derived) && dtio_sub == NULL)

diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_17.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_17.f90
index 4c2a7d657ee1b8bc05ad01897041a5379542de3e..b302d538d9f2b488aa5f093d23b4e943560e8834 100644 (file)
--- a/gcc/testsuite/gfortran.dg/c_loc_test_17.f90
+++ b/gcc/testsuite/gfortran.dg/c_loc_test_17.f90
@@ -1,5 +1,4 @@
 ! { dg-do compile }
-! { dg-options "" }
 !
 ! PR fortran/56378
 ! PR fortran/52426
@@ -24,5 +23,6 @@ contains
 end module
 
 use iso_c_binding
-print *, c_loc([1]) ! { dg-error "Argument X at .1. to C_LOC shall have either the POINTER or the TARGET attribute" }
+type(c_ptr) :: i
+i = c_loc([1]) ! { dg-error "Argument X at .1. to C_LOC shall have either the POINTER or the TARGET attribute" }
 end

diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_10.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_10.f03
index 4ce1c6809e407af4536576d229f8e8a601caa4f2..1c81e19ca782b602928bf39f1888378f815a3a74 100644 (file)
--- a/gcc/testsuite/gfortran.dg/c_ptr_tests_10.f03
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_10.f03
@@ -1,13 +1,12 @@
 ! { dg-do run }
-! { dg-options "-std=gnu" }
 ! This test case exists because gfortran had an error in converting the 
 ! expressions for the derived types from iso_c_binding in some cases.
 module c_ptr_tests_10
-  use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr
+  use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr, c_intptr_t
 
 contains
   subroutine sub0() bind(c)
-    print *, 'c_null_ptr is: ', c_null_ptr
+    print *, 'c_null_ptr is: ', transfer (cptr, 0_C_INTPTR_T)
   end subroutine sub0
 end module c_ptr_tests_10
 

diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90
index 68c1da161a07d53e0a50da78b41c31f36743cfd0..d1f74857c78fd532ae3f77d14a1b17a4502ce723 100644 (file)
--- a/gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90
@@ -22,13 +22,13 @@ end program test
 subroutine bug1
    use ISO_C_BINDING
    implicit none
-   type(c_ptr) :: m
+   type(c_ptr) :: m, i
    type mytype
      integer a, b, c
    end type mytype
    type(mytype) x
    print *, transfer(32512, x)  ! Works.
-   print *, transfer(32512, m)  ! Caused ICE.
+   i = transfer(32512, m)  ! Caused ICE.
 end subroutine bug1 
 
 subroutine bug6

diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03
index 5a32553b8c59611f9ab71fef044f918e2efaa88f..60bf32802cb0afa278ed823483169f03ad5c6600 100644 (file)
--- a/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03
@@ -4,7 +4,7 @@
 ! done to c_ptr and c_funptr (translating them to void *) works in the case 
 ! where a component of a type is of type c_ptr or c_funptr.  
 module c_ptr_tests_9
-  use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr
+  use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr, c_intptr_t
 
   type myF90Derived
      type(c_ptr) :: my_c_ptr
@@ -16,9 +16,9 @@ contains
     type(myF90Derived), pointer :: my_f90_type_ptr
 
     my_f90_type%my_c_ptr = c_null_ptr
-    print *, 'my_f90_type is: ', my_f90_type%my_c_ptr
+    print *, 'my_f90_type is: ', transfer(my_f90_type%my_c_ptr,  0_C_INTPTR_T)
     my_f90_type_ptr => my_f90_type
-    print *, 'my_f90_type_ptr is: ', my_f90_type_ptr%my_c_ptr
+    print *, 'my_f90_type_ptr is: ', transfer(my_f90_type_ptr%my_c_ptr,  0_C_INTPTR_T)
   end subroutine sub0
 end module c_ptr_tests_9
 

diff --git a/gcc/testsuite/gfortran.dg/init_flag_17.f90 b/gcc/testsuite/gfortran.dg/init_flag_17.f90
index 401830fccbc7715679a944f495c55fb845696738..57ea604c0962c55ac1229e61999c1d44ea128064 100644 (file)
--- a/gcc/testsuite/gfortran.dg/init_flag_17.f90
+++ b/gcc/testsuite/gfortran.dg/init_flag_17.f90
@@ -19,9 +19,8 @@ program init_flag_17
 
   type(ty) :: t
 
-  print *, t%ptr
-  print *, t%fptr
-
+  print *, transfer(t%ptr, 0_C_INTPTR_T)
+  print *, transfer(t%fptr, 0_C_INTPTR_T)
 end program
 
 ! { dg-final { scan-tree-dump "\.ptr=0" "original" } }

diff --git a/gcc/testsuite/gfortran.dg/pr32601_1.f03 b/gcc/testsuite/gfortran.dg/pr32601_1.f03
index a297e1728ec1a3658f231161f810e14eb1ec95c7..6abca76c28111e53463170134a2c2942c0d5e36d 100644 (file)
--- a/gcc/testsuite/gfortran.dg/pr32601_1.f03
+++ b/gcc/testsuite/gfortran.dg/pr32601_1.f03
@@ -4,9 +4,9 @@
 ! PR fortran/32601
 use, intrinsic :: iso_c_binding, only: c_loc, c_ptr
 implicit none
-
+type(c_ptr) :: i
 ! This was causing an ICE, but is an error because the argument to C_LOC 
 ! needs to be a variable.
-print *, c_loc(4) ! { dg-error "shall have either the POINTER or the TARGET attribute" }
+i = c_loc(4) ! { dg-error "shall have either the POINTER or the TARGET attribute" }
 
 end