Revert "Fortran: Generate a runtime error on recursive I/O"

This reverts commit 489423763d3c8b84d3409f4b200fb6b19ad96db3.

diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index a0dd3d891a4ef765da7453718ba843d7f6b58db5..2adfd3c64a9a1d35b5e7ff4a81890385b2475641 100644 (file)
--- 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 (file)
index e579083..0000000
--- 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 e77453bb72b2c9f5bf5a6e519bbd984447553447..91ece4d27d1f2b3dbf1dd0e5a91f51795beb254b 100644 (file)
--- 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 7e6795e70f7e24620ee022aa2526a102d6c872c8..ed14204e8efaf3dd9892e5dd244ae68cdadcfe32 100644 (file)
--- 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 fdb19eb57bde93e8494ddab93e6c9650f9fc245d..866862ac7c6a5918a3d2b0417d8e8a74ceacf548 100644 (file)
--- 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 7192f1341306c7edacb185c2651bf7c1da103cf5..6245aa45f8c2368d11fb141cf15c6c8d9d6442de 100644 (file)
--- 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;