https://gcc.gnu.org/g:12771b1d77aef71f9eceead9b46323292f3dd7e4
commit r15-7569-g12771b1d77aef71f9eceead9b46323292f3dd7e4
Author: Jerry DeLisle <jvdeli...@gcc.gnu.org>
Date: Thu Feb 13 20:19:56 2025 -0800
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:
---
gcc/fortran/resolve.cc | 4 ++--
gcc/testsuite/gfortran.dg/c_loc_test_17.f90 | 4 ++--
gcc/testsuite/gfortran.dg/c_ptr_tests_10.f03 | 5 ++---
gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90 | 4 ++--
gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03 | 6 +++---
gcc/testsuite/gfortran.dg/init_flag_17.f90 | 5 ++---
gcc/testsuite/gfortran.dg/pr32601_1.f03 | 4 ++--
7 files changed, 15 insertions(+), 17 deletions(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 1a4799dac78f..3d3f117216ca 100644
--- 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 4c2a7d657ee1..b302d538d9f2 100644
--- 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 4ce1c6809e40..1c81e19ca782 100644
--- 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 68c1da161a07..d1f74857c78f 100644
--- 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 5a32553b8c59..60bf32802cb0 100644
--- 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 401830fccbc7..57ea604c0962 100644
--- 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 a297e1728ec1..6abca76c2811 100644
--- 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
