https://gcc.gnu.org/g:e6c378fa5200cd8eb8b4356ef33e88fd13ee5436
commit r16-6469-ge6c378fa5200cd8eb8b4356ef33e88fd13ee5436 Author: Jerry DeLisle <[email protected]> Date: Fri Jan 2 17:44:05 2026 -0800 Revert "Fortran: Generate a runtime error on recursive I/O" This reverts commit 489423763d3c8b84d3409f4b200fb6b19ad96db3. Diff: --- gcc/fortran/libgfortran.h | 1 - gcc/testsuite/gfortran.dg/pr119136.f90 | 10 ---------- libgfortran/io/io.h | 4 ++-- libgfortran/io/transfer.c | 2 -- libgfortran/io/unit.c | 31 ++----------------------------- libgfortran/runtime/error.c | 4 ---- 6 files changed, 4 insertions(+), 48 deletions(-) diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index a0dd3d891a4e..2adfd3c64a9a 100644 --- a/gcc/fortran/libgfortran.h +++ b/gcc/fortran/libgfortran.h @@ -143,7 +143,6 @@ typedef enum LIBERROR_INQUIRE_INTERNAL_UNIT, /* Must be different from STAT_STOPPED_IMAGE. */ LIBERROR_BAD_WAIT_ID, LIBERROR_NO_MEMORY, - LIBERROR_RECURSIVE_IO, LIBERROR_LAST /* Not a real error, the last error # + 1. */ } libgfortran_error_codes; diff --git a/gcc/testsuite/gfortran.dg/pr119136.f90 b/gcc/testsuite/gfortran.dg/pr119136.f90 deleted file mode 100644 index e579083b9b6a..000000000000 --- a/gcc/testsuite/gfortran.dg/pr119136.f90 +++ /dev/null @@ -1,10 +0,0 @@ -! { dg-do run } -! { dg-shouldfail "Recursive" } - print *, foo_io() -contains - function foo_io() - integer :: foo_io(2) - print * , "foo" - foo_io = [42, 42] - end function -end diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index e77453bb72b2..91ece4d27d1f 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -782,8 +782,8 @@ internal_proto(close_unit); extern gfc_unit *set_internal_unit (st_parameter_dt *, gfc_unit *, int); internal_proto(set_internal_unit); -extern void check_for_recursive (st_parameter_dt *dtp); -internal_proto(check_for_recursive); +extern void stash_internal_unit (st_parameter_dt *); +internal_proto(stash_internal_unit); extern gfc_unit *find_unit (int); internal_proto(find_unit); diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 7e6795e70f7e..ed14204e8efa 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -3129,8 +3129,6 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) NOTE ("data_transfer_init"); - check_for_recursive (dtp); - ionml = ((cf & IOPARM_DT_IONML_SET) != 0) ? dtp->u.p.ionml : NULL; memset (&dtp->u.p, 0, sizeof (dtp->u.p)); diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index fdb19eb57bde..866862ac7c6a 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -324,7 +324,8 @@ delete_unit (gfc_unit *old) } /* get_gfc_unit_from_root()-- Given an integer, return a pointer - to the unit structure. Returns NULL if the unit does not exist. */ + to the unit structure. Returns NULL if the unit does not exist, + otherwise returns a locked unit. */ static inline gfc_unit * get_gfc_unit_from_unit_root (int n) @@ -345,34 +346,6 @@ get_gfc_unit_from_unit_root (int n) return p; } -/* Recursive I/O is not allowed. Check to see if the UNIT exists and if - so, check if the UNIT is locked already. This check does not apply - to DTIO. */ -void -check_for_recursive (st_parameter_dt *dtp) -{ - gfc_unit *p; - - p = get_gfc_unit_from_unit_root(dtp->common.unit); - if (p != NULL) - { - if (!(dtp->common.flags & IOPARM_DT_HAS_INTERNAL_UNIT)) - /* The unit p is external. */ - { - /* Check if this is a parent I/O. */ - if (p->child_dtio == 0) - { - if (TRYLOCK(&p->lock)) - { - generate_error (&dtp->common, LIBERROR_RECURSIVE_IO, NULL); - return; - } - UNLOCK(&p->lock); - } - } - } -} - /* get_gfc_unit()-- Given an integer, return a pointer to the unit structure. Returns NULL if the unit does not exist, otherwise returns a locked unit. */ diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 7192f1341306..6245aa45f8c2 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -633,10 +633,6 @@ translate_error (int code) p = "Bad ID in WAIT statement"; break; - case LIBERROR_RECURSIVE_IO: - p = "Recursive I/O not allowed"; - break; - default: p = "Unknown error code"; break;
