I wrote:
This gets rid of the thread sanitizer issue; the thread sanitizer
output is clean. However, I would appreciate feedback about whether
this approach (and my code) is correct.
Regression-tested.
Here is an update: The previous version of the patch had a regression,
which is removed (with a test case) with the current version.
Also regression-tested.
So,
> Comments? Suggestions for improvements/other approaches? Close the PR
> as WONTFIX instead? OK for trunk?
Regards
Thomas
2017-09-29 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/66756
* io/fbuf.c (fbuf_destroy): Add argument "locked". Lock unit
before freeing the buffer if necessary.
* io/unit.c (insert_unit): Do not create lock and lock, move to
(gfc_get_unit): here; lock after insert_unit has succeded.
(init_units): Do not unlock unit locks for stdin, stdout and
stderr.
2017-09-29 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/66756
* gfortran.dg/openmp-close.f90: New test.
Index: io/fbuf.c
===================================================================
--- io/fbuf.c (Revision 253162)
+++ io/fbuf.c (Arbeitskopie)
@@ -46,13 +46,17 @@ fbuf_init (gfc_unit *u, int len)
void
-fbuf_destroy (gfc_unit *u)
+fbuf_destroy (gfc_unit *u, int locked)
{
if (u->fbuf == NULL)
return;
+ if (locked)
+ __gthread_mutex_lock (&u->lock);
free (u->fbuf->buf);
free (u->fbuf);
u->fbuf = NULL;
+ if (locked)
+ __gthread_mutex_unlock (&u->lock);
}
Index: io/fbuf.h
===================================================================
--- io/fbuf.h (Revision 253162)
+++ io/fbuf.h (Arbeitskopie)
@@ -47,7 +47,7 @@ struct fbuf
extern void fbuf_init (gfc_unit *, int);
internal_proto(fbuf_init);
-extern void fbuf_destroy (gfc_unit *);
+extern void fbuf_destroy (gfc_unit *, int);
internal_proto(fbuf_destroy);
extern int fbuf_reset (gfc_unit *);
Index: io/unit.c
===================================================================
--- io/unit.c (Revision 253162)
+++ io/unit.c (Arbeitskopie)
@@ -221,23 +221,14 @@ insert (gfc_unit *new, gfc_unit *t)
return t;
}
+/* insert_unit()-- Create a new node, insert it into the treap. It is assumed
+ that the caller holds unit_lock. */
-/* insert_unit()-- Create a new node, insert it into the treap. */
-
static gfc_unit *
insert_unit (int n)
{
gfc_unit *u = xcalloc (1, sizeof (gfc_unit));
u->unit_number = n;
-#ifdef __GTHREAD_MUTEX_INIT
- {
- __gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT;
- u->lock = tmp;
- }
-#else
- __GTHREAD_MUTEX_INIT_FUNCTION (&u->lock);
-#endif
- __gthread_mutex_lock (&u->lock);
u->priority = pseudo_random ();
unit_root = insert (u, unit_root);
return u;
@@ -361,9 +352,20 @@ retry:
if (created)
{
- /* Newly created units have their lock held already
- from insert_unit. Just unlock UNIT_LOCK and return. */
+#ifdef __GTHREAD_MUTEX_INIT
+ {
+ __gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT;
+ p->lock = tmp;
+ }
+#else
+ __GTHREAD_MUTEX_INIT_FUNCTION (&p->lock);
+#endif
__gthread_mutex_unlock (&unit_lock);
+
+ /* Nobody outside this address has seen this unit yet. We could safely
+ keep it unlocked until now. */
+
+ __gthread_mutex_lock (&p->lock);
return p;
}
@@ -618,8 +620,6 @@ init_units (void)
u->filename = strdup (stdin_name);
fbuf_init (u, 0);
-
- __gthread_mutex_unlock (&u->lock);
}
if (options.stdout_unit >= 0)
@@ -649,8 +649,6 @@ init_units (void)
u->filename = strdup (stdout_name);
fbuf_init (u, 0);
-
- __gthread_mutex_unlock (&u->lock);
}
if (options.stderr_unit >= 0)
@@ -680,8 +678,6 @@ init_units (void)
fbuf_init (u, 256); /* 256 bytes should be enough, probably not doing
any kind of exotic formatting to stderr. */
-
- __gthread_mutex_unlock (&u->lock);
}
/* Calculate the maximum file offset in a portable manner.
@@ -719,7 +715,7 @@ close_unit_1 (gfc_unit *u, int locked)
u->filename = NULL;
free_format_hash_table (u);
- fbuf_destroy (u);
+ fbuf_destroy (u, locked);
if (u->unit_number <= NEWUNIT_START)
newunit_free (u->unit_number);
! { dg-do run }
! { dg-require-effective-target fopenmp }
! { dg-additional-options "-fopenmp" }
program main
use omp_lib
!$OMP PARALLEL NUM_THREADS(100)
write (10,*) 'asdf'
!$OMP END PARALLEL
close(10,status="delete")
end program main
