The attached patch is fairly obvious. The use of notify_std is changed
to a gfc_error. Several test cases had to be adjusted.
Regression tested on x86_64.
OK for trunk?
Regards,
Jerry
Author: Jerry DeLisle <jvdeli...@gcc.gnu.org>
Date: Tue Feb 11 20:57:50 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): Issue the error
with no exceptions allowed.
gcc/testsuite/ChangeLog:
* gfortran.dg/c_loc_test_17.f90: Modify to pass.
* gfortran.dg/c_ptr_tests_10.f03: Likewise.
* gfortran.dg/c_ptr_tests_16.f90: Likewise.
* gfortran.dg/c_ptr_tests_9.f03: Likewise.
* gfortran.dg/init_flag_17.f90: Likewise.
* gfortran.dg/pr32601_1.f03: Likewise.
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 1a4799dac78..3d3f117216c 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 4c2a7d657ee..92bfca4363d 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,5 @@ 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" }
+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 4ce1c6809e4..834570cb74d 100644
--- a/gcc/testsuite/gfortran.dg/c_ptr_tests_10.f03
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_10.f03
@@ -1,5 +1,4 @@
! { 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
@@ -7,7 +6,7 @@ module c_ptr_tests_10
contains
subroutine sub0() bind(c)
- print *, 'c_null_ptr is: ', c_null_ptr
+ print *, 'c_null_ptr is: ', transfer (cptr, C_LONG_LONG)
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 68c1da161a0..d1f74857c78 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 5a32553b8c5..711b9c157d4 100644
--- a/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03
@@ -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, C_LONG_LONG)
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, C_LONG_LONG)
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 401830fccbc..8bb9f7b1ef7 100644
--- a/gcc/testsuite/gfortran.dg/init_flag_17.f90
+++ b/gcc/testsuite/gfortran.dg/init_flag_17.f90
@@ -19,8 +19,8 @@ program init_flag_17
type(ty) :: t
- print *, t%ptr
- print *, t%fptr
+ print *, transfer(t%ptr, c_long_long)
+ print *, transfer(t%fptr, c_long_long)
end program
diff --git a/gcc/testsuite/gfortran.dg/pr32601_1.f03 b/gcc/testsuite/gfortran.dg/pr32601_1.f03
index a297e1728ec..1a48419112d 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
-
+integer 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
