This patch is a version of Jerry's patch with one additional feature.
When locking a unit, the thread ID of the locking thread also stored
in the gfc_unit structure. When the unit is found to be locked, it can
be either have been locked by the same thread (bad, recursive I/O) or
by another thread (harmless).
Regression-tested fully (make -j8 check in the gcc build directory) on
Linux, which links in pthreads by default. Steve checked on FreeBSD,
which does not do so.
Jerry DeLisle <jvdelisle@gcc.gnu.org>
Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/119136
gcc/fortran/ChangeLog:
* libgfortran.h: Add enum for new LIBERROR_RECURSIVE_IO.
libgfortran/ChangeLog:
* io/async.h (UNLOCK_UNIT): New macro.
(TRYLOCK_UNIT): New macro.
(LOCK_UNIT): New macro.
* io/io.h: Delete prototype for unused stash_internal_unit.
(check_for_recursive): Add prototype for this new function.
* io/transfer.c (data_transfer_init): Add call to new
check_for_recursive.
* io/unit.c (delete_unit): Fix comment.
(check_for_recursive): Add new function.
(init_units): Use new macros.
(close_unit_1): Likewise.
(unlock_unit): Likewise.
* io/unix.c (flush_all_units_1): Likewise.
(flush_all_units): Likewise.
* runtime/error.c (translate_error): : Add translation for
"Recursive I/O not allowed runtime error message.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr119136.f90: New test.
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;
--- /dev/null
+! { 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
INTERN_UNLOCK (mutex); \
}while (0)
+#define UNLOCK_UNIT(unit) do { \
+ unit->self = 0; \
+ UNLOCK(&(unit)->lock); \
+ } while(0)
+
#define TRYLOCK(mutex) ({ \
char status[200]; \
int res; \
res; \
})
+#define TRYLOCK_UNIT(unit) ({ \
+ char status[200]; \
+ int res; \
+ aio_lock_debug *curr; \
+ __gthread_mutex_t *mutex = &(unit)->lock; \
+ res = __gthread_mutex_trylock (mutex); \
+ INTERN_LOCK (&debug_queue_lock); \
+ if (res) { \
+ if ((curr = IN_DEBUG_QUEUE (mutex))) { \
+ sprintf (status, DEBUG_RED "%s():%d" DEBUG_NORM, curr->func, curr->line); \
+ } else \
+ sprintf (status, DEBUG_RED "unknown" DEBUG_NORM); \
+ } \
+ else { \
+ sprintf (status, DEBUG_GREEN "unlocked" DEBUG_NORM); \
+ MUTEX_DEBUG_ADD (mutex); \
+ } \
+ DEBUG_PRINTF ("%s%-44s prev: %-35s %20s():%-5d %18p\n", aio_prefix, \
+ DEBUG_DARKRED "TRYLOCK: " DEBUG_NORM #unit, status, __FUNCTION__, __LINE__, \
+ (void *) mutex); \
+ INTERN_UNLOCK (&debug_queue_lock); \
+ res; \
+ })
+
#define LOCK(mutex) do { \
char status[200]; \
CHECK_LOCK (mutex, status); \
DEBUG_PRINTF ("%s" DEBUG_RED "ACQ:" DEBUG_NORM " %-30s %78p\n", aio_prefix, #mutex, mutex); \
} while (0)
+
+#define LOCK_UNIT(unit) do { \
+ LOCK (&(unit)->lock); \
+ (unit)->self = __gthread_self (); \
+ } while (0)
+
#ifdef __GTHREAD_RWLOCK_INIT
#define RWLOCK_DEBUG_ADD(rwlock) do { \
aio_rwlock_debug *n; \
#define DEBUG_LINE(...)
#define T_ERROR(func, ...) func(__VA_ARGS__)
#define LOCK(mutex) INTERN_LOCK (mutex)
+#define LOCK_UNIT(unit) do { \
+ if (__gthread_active_p ()) { \
+ LOCK (&(unit)->lock); (unit)->self = __gthread_self (); \
+ } \
+ } while(0)
#define UNLOCK(mutex) INTERN_UNLOCK (mutex)
+#define UNLOCK_UNIT(unit) do { \
+ if (__gthread_active_p ()) { \
+ (unit)->self = 0 ; UNLOCK(&(unit)->lock); \
+ } \
+ } while(0)
#define TRYLOCK(mutex) (__gthread_mutex_trylock (mutex))
+#define TRYLOCK_UNIT(unit) ({ \
+ int res; \
+ if (__gthread_active_p ()) { \
+ res = __gthread_mutex_trylock (&(unit)->lock); \
+ if (!res) \
+ (unit)->self = __gthread_self (); \
+ } \
+ else \
+ res = 0; \
+ res; \
+ })
#ifdef __GTHREAD_RWLOCK_INIT
#define RDLOCK(rwlock) INTERN_RDLOCK (rwlock)
#define WRLOCK(rwlock) INTERN_WRLOCK (rwlock)
int last_char;
bool has_size;
GFC_IO_INT size_used;
+#ifdef __GTHREADS_CXX0X
+ __gthread_t self;
+#endif
}
gfc_unit;
extern gfc_unit *set_internal_unit (st_parameter_dt *, gfc_unit *, int);
internal_proto(set_internal_unit);
-extern void stash_internal_unit (st_parameter_dt *);
-internal_proto(stash_internal_unit);
+extern void check_for_recursive (st_parameter_dt *dtp);
+internal_proto(check_for_recursive);
extern gfc_unit *find_unit (int);
internal_proto(find_unit);
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));
#else
__GTHREAD_MUTEX_INIT_FUNCTION (&u->lock);
#endif
- LOCK (&u->lock);
+ LOCK_UNIT (u);
u->priority = pseudo_random ();
unit_root = insert (u, unit_root);
return u;
}
/* get_gfc_unit_from_root()-- Given an integer, return a pointer
- to the unit structure. Returns NULL if the unit does not exist,
- otherwise returns a locked unit. */
+ to the unit structure. Returns NULL if the unit does not exist. */
static inline gfc_unit *
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_UNIT(p))
+ {
+ /* The lock failed. This unit is locked either our own
+ thread, which is illegal recursive I/O, or somebody by
+ else, in which case we are doing OpenMP or similar; this
+ is harmless and permitted. */
+ __gthread_t locker = __atomic_load_n (&p->self, __ATOMIC_RELAXED);
+ if (locker == __gthread_self ())
+ generate_error (&dtp->common, LIBERROR_RECURSIVE_IO, NULL);
+ return;
+ }
+ else
+ 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. */
if (p != NULL && (p->child_dtio == 0))
{
/* Fast path. */
- if (! TRYLOCK (&p->lock))
+ if (! TRYLOCK_UNIT (p))
{
/* assert (p->closed == 0); */
RWUNLOCK (&unit_rwlock);
if (p != NULL && (p->child_dtio == 0))
{
- LOCK (&p->lock);
+ LOCK_UNIT (p);
if (p->closed)
{
WRLOCK (&unit_rwlock);
- UNLOCK (&p->lock);
+ UNLOCK_UNIT (p);
if (predec_waiting_locked (p) == 0)
destroy_unit_mutex (p);
goto retry;
fbuf_init (u, 0);
- UNLOCK (&u->lock);
+ UNLOCK_UNIT (u);
}
if (options.stdout_unit >= 0)
fbuf_init (u, 0);
- UNLOCK (&u->lock);
+ UNLOCK_UNIT (u);
}
if (options.stderr_unit >= 0)
fbuf_init (u, 256); /* 256 bytes should be enough, probably not doing
any kind of exotic formatting to stderr. */
- UNLOCK (&u->lock);
+ UNLOCK_UNIT (u);
}
/* The default internal units. */
u = insert_unit (GFC_INTERNAL_UNIT);
- UNLOCK (&u->lock);
+ UNLOCK_UNIT (u);
u = insert_unit (GFC_INTERNAL_UNIT4);
- UNLOCK (&u->lock);
+ UNLOCK_UNIT (u);
}
newunit_free (u->unit_number);
if (!locked)
- UNLOCK (&u->lock);
+ UNLOCK_UNIT (u);
/* If there are any threads waiting in find_unit for this unit,
avoid freeing the memory, the last such thread will free it
if (u)
{
NOTE ("unlock_unit = %d", u->unit_number);
- UNLOCK (&u->lock);
+ UNLOCK_UNIT (u);
NOTE ("unlock_unit done");
}
}
RWUNLOCK (&unit_rwlock);
if (u != NULL)
{
- LOCK (&u->lock);
+ LOCK_UNIT (u);
if (u->closed)
{
RDLOCK (&unit_rwlock);
- UNLOCK (&u->lock);
+ UNLOCK_UNIT (u);
if (predec_waiting_locked (u) == 0)
free (u);
goto retry;
return u;
if (u->s)
sflush (u->s);
- UNLOCK (&u->lock);
+ UNLOCK_UNIT (u);
}
u = u->right;
}
if (u == NULL)
return;
- LOCK (&u->lock);
+ LOCK_UNIT (u);
min_unit = u->unit_number + 1;
{
sflush (u->s);
WRLOCK (&unit_rwlock);
- UNLOCK (&u->lock);
+ UNLOCK_UNIT (u);
(void) predec_waiting_locked (u);
}
else
{
WRLOCK (&unit_rwlock);
- UNLOCK (&u->lock);
+ UNLOCK_UNIT (u);
if (predec_waiting_locked (u) == 0)
free (u);
}
p = "Bad ID in WAIT statement";
break;
+ case LIBERROR_RECURSIVE_IO:
+ p = "Recursive I/O not allowed";
+ break;
+
default:
p = "Unknown error code";
break;
projects / thirdparty / gcc.git / commitdiff
