Merge from trunk at:

	commit 56638b9b1853666f575928f8baf17f70e4ed3517
	Author: GCC Administrator <gccadmin@gcc.gnu.org>
	Date:   Wed Jun 17 00:16:36 2020 +0000

	    Daily bump.

8 files changed, 82 insertions, 52 deletions

diff --git a/libgfortran/io/async.c b/libgfortran/io/async.c
index ab214af..1bf38e9 100644
--- a/libgfortran/io/async.c
+++ b/libgfortran/io/async.c
@@ -80,7 +80,6 @@ update_pdt (st_parameter_dt **old, st_parameter_dt *new) {
 static void
 destroy_adv_cond (struct adv_cond *ac)
 {
-  T_ERROR (__gthread_mutex_destroy, &ac->lock);
   T_ERROR (__gthread_cond_destroy, &ac->signal);
 }
 
@@ -156,6 +155,7 @@ async_io (void *arg)
 
 		case AIO_CLOSE:
 		  NOTE ("Received AIO_CLOSE");
+		  LOCK (&au->lock);
 		  goto finish_thread;
 
 		default:
@@ -175,7 +175,6 @@ async_io (void *arg)
 	      else if (ctq->type == AIO_CLOSE)
 		{
 		  NOTE ("Received AIO_CLOSE during error condition");
-		  UNLOCK (&au->lock);
 		  goto finish_thread;
 		}
 	    }
@@ -189,9 +188,7 @@ async_io (void *arg)
       au->tail = NULL;
       au->head = NULL;
       au->empty = 1;
-      UNLOCK (&au->lock);
       SIGNAL (&au->emptysignal);
-      LOCK (&au->lock);
     }
  finish_thread:
   au->tail = NULL;
@@ -199,6 +196,7 @@ async_io (void *arg)
   au->empty = 1;
   SIGNAL (&au->emptysignal);
   free (ctq);
+  UNLOCK (&au->lock);
   return NULL;
 }
 
@@ -223,7 +221,6 @@ static void
 init_adv_cond (struct adv_cond *ac)
 {
   ac->pending = 0;
-  __GTHREAD_MUTEX_INIT_FUNCTION (&ac->lock);
   __GTHREAD_COND_INIT_FUNCTION (&ac->signal);
 }
 
@@ -279,8 +276,8 @@ enqueue_transfer (async_unit *au, transfer_args *arg, enum aio_do type)
   au->tail = tq;
   REVOKE_SIGNAL (&(au->emptysignal));
   au->empty = false;
-  UNLOCK (&au->lock);
   SIGNAL (&au->work);
+  UNLOCK (&au->lock);
 }
 
 /* Enqueue an st_write_done or st_read_done which contains an ID.  */
@@ -303,8 +300,8 @@ enqueue_done_id (async_unit *au, enum aio_do type)
   au->empty = false;
   ret = au->id.high++;
   NOTE ("Enqueue id: %d", ret);
-  UNLOCK (&au->lock);
   SIGNAL (&au->work);
+  UNLOCK (&au->lock);
   return ret;
 }
 
@@ -324,8 +321,8 @@ enqueue_done (async_unit *au, enum aio_do type)
   au->tail = tq;
   REVOKE_SIGNAL (&(au->emptysignal));
   au->empty = false;
-  UNLOCK (&au->lock);
   SIGNAL (&au->work);
+  UNLOCK (&au->lock);
 }
 
 /* Enqueue a CLOSE statement.  */
@@ -344,8 +341,8 @@ enqueue_close (async_unit *au)
   au->tail = tq;
   REVOKE_SIGNAL (&(au->emptysignal));
   au->empty = false;
-  UNLOCK (&au->lock);
   SIGNAL (&au->work);
+  UNLOCK (&au->lock);
 }
 
 /* The asynchronous unit keeps the currently active PDT around.
@@ -374,9 +371,9 @@ enqueue_data_transfer_init (async_unit *au, st_parameter_dt *dt, int read_flag)
     au->tail->next = tq;
   au->tail = tq;
   REVOKE_SIGNAL (&(au->emptysignal));
-  au->empty = 0;
-  UNLOCK (&au->lock);
+  au->empty = false;
   SIGNAL (&au->work);
+  UNLOCK (&au->lock);
 }
 
 /* Collect the errors that may have happened asynchronously.  Return true if
@@ -427,12 +424,17 @@ async_wait_id (st_parameter_common *cmp, async_unit *au, int i)
     }
 
   LOCK (&au->lock);
+  if (i > au->id.high)
+    {
+      generate_error_common (cmp, LIBERROR_BAD_WAIT_ID, NULL);
+      UNLOCK (&au->lock);
+      return true;
+    }
+
   NOTE ("Waiting for id %d", i);
   if (au->id.waiting < i)
     au->id.waiting = i;
-  UNLOCK (&au->lock);
   SIGNAL (&(au->work));
-  LOCK (&au->lock);
   WAIT_SIGNAL_MUTEX (&(au->id.done),
 		     (au->id.low >= au->id.waiting || au->empty), &au->lock);
   LOCK (&au->lock);
@@ -454,8 +456,8 @@ async_wait (st_parameter_common *cmp, async_unit *au)
   if (cmp == NULL)
     cmp = au->error.cmp;
 
-  SIGNAL (&(au->work));
   LOCK (&(au->lock));
+  SIGNAL (&(au->work));
 
   if (au->empty)
     {
diff --git a/libgfortran/io/async.h b/libgfortran/io/async.h
index c6b2e0f..17d303c 100644
--- a/libgfortran/io/async.h
+++ b/libgfortran/io/async.h
@@ -229,44 +229,44 @@
 
 #if ASYNC_IO
 
+/* au->lock has to be held when calling this macro.  */
+
 #define SIGNAL(advcond) do{						\
-    INTERN_LOCK (&(advcond)->lock);					\
     (advcond)->pending = 1;						\
     DEBUG_PRINTF ("%s%-75s %20s():%-5d %18p\n", aio_prefix, DEBUG_ORANGE "SIGNAL: " DEBUG_NORM \
 		 #advcond, __FUNCTION__, __LINE__, (void *) advcond);	\
-    T_ERROR (__gthread_cond_broadcast, &(advcond)->signal);		\
-    INTERN_UNLOCK (&(advcond)->lock);					\
+    T_ERROR (__gthread_cond_broadcast, &(advcond)->signal);			\
   } while (0)
 
+/* Has to be entered with mutex locked.  */
+
 #define WAIT_SIGNAL_MUTEX(advcond, condition, mutex) do{		\
     __label__ finish;		       					\
-    INTERN_LOCK (&((advcond)->lock));					\
     DEBUG_PRINTF ("%s%-75s %20s():%-5d %18p\n", aio_prefix, DEBUG_BLUE "WAITING: " DEBUG_NORM \
 		 #advcond, __FUNCTION__, __LINE__, (void *) advcond);	\
-    if ((advcond)->pending || (condition)){				\
-      UNLOCK (mutex);							\
+    if ((advcond)->pending || (condition))				\
       goto finish;							\
-    }									\
-    UNLOCK (mutex);							\
-     while (!__gthread_cond_wait(&(advcond)->signal, &(advcond)->lock)) {	\
-       { int cond;							\
-	 LOCK (mutex); cond = condition; UNLOCK (mutex);	\
-	   if (cond){							\
-	     DEBUG_PRINTF ("%s%-75s %20s():%-5d %18p\n", aio_prefix, DEBUG_ORANGE "REC: " DEBUG_NORM \
-		  #advcond,  __FUNCTION__, __LINE__, (void *)advcond);	\
-	   break;				      			\
-        }							\
+    while (1)								\
+      {									\
+	int err_ret = __gthread_cond_wait(&(advcond)->signal, mutex);	\
+	if (err_ret) internal_error (NULL, "WAIT_SIGNAL_MUTEX failed");	\
+	if (condition)							\
+	  {								\
+	    DEBUG_PRINTF ("%s%-75s %20s():%-5d %18p\n", aio_prefix, DEBUG_ORANGE \
+			  "REC: " DEBUG_NORM				\
+			  #advcond,  __FUNCTION__, __LINE__, (void *)advcond); \
+	    break;				      			\
+	  }								\
       }									\
-    }									\
   finish:								\
-		 (advcond)->pending = 0;				\
-		 INTERN_UNLOCK (&((advcond)->lock));			\
-		 } while (0)
+    (advcond)->pending = 0;						\
+    UNLOCK (mutex);							\
+  } while (0)
+
+/* au->lock has to be held when calling this macro.  */
 
 #define REVOKE_SIGNAL(advcond) do{		\
-    INTERN_LOCK (&(advcond)->lock);		\
     (advcond)->pending = 0;			\
-    INTERN_UNLOCK (&(advcond)->lock);		\
   } while (0)
 
 #else
@@ -330,7 +330,6 @@ struct adv_cond
 {
 #if ASYNC_IO
   int pending;
-  __gthread_mutex_t lock;
   __gthread_cond_t signal;
 #endif
 };
diff --git a/libgfortran/io/close.c b/libgfortran/io/close.c
index 8aaa003..17e064b 100644
--- a/libgfortran/io/close.c
+++ b/libgfortran/io/close.c
@@ -31,7 +31,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #endif
 
 typedef enum
-{ CLOSE_DELETE, CLOSE_KEEP, CLOSE_UNSPECIFIED }
+{ CLOSE_INVALID = - 1, CLOSE_DELETE, CLOSE_KEEP, CLOSE_UNSPECIFIED }
 close_status;
 
 static const st_option status_opt[] = {
@@ -61,6 +61,12 @@ st_close (st_parameter_close *clp)
     find_option (&clp->common, clp->status, clp->status_len,
 		 status_opt, "Bad STATUS parameter in CLOSE statement");
 
+  if (status == CLOSE_INVALID)
+    {
+      library_end ();
+      return;
+    }
+
   u = find_unit (clp->common.unit);
 
   if (ASYNC_IO && u && u->au)
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index b42a559..3be861f 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -954,7 +954,9 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
 	    }
 	  tail->u.real.d = fmt->value;
 	  
-	  /* Look for optional exponent */
+	  /* Look for optional exponent, not allowed for FMT_D */
+	  if (t == FMT_D)
+	    break;
 	  u = format_lex (fmt);
 	  if (u != FMT_E)
 	    fmt->saved_token = u;
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index b8db47d..dc18bc3 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -4123,6 +4123,14 @@ finalize_transfer (st_parameter_dt *dtp)
   if ((dtp->u.p.ionml != NULL)
       && (cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0)
     {
+       if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED)
+	 {
+	   generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
+			   "Namelist formatting for unit connected "
+			   "with FORM='UNFORMATTED'");
+	   return;
+	 }
+
        dtp->u.p.namelist_mode = 1;
        if ((cf & IOPARM_DT_NAMELIST_READ_MODE) != 0)
 	 namelist_read (dtp);
@@ -4492,7 +4500,7 @@ void
 st_wait_async (st_parameter_wait *wtp)
 {
   gfc_unit *u = find_unit (wtp->common.unit);
-  if (ASYNC_IO && u->au)
+  if (ASYNC_IO && u && u->au)
     {
       if (wtp->common.flags & IOPARM_WAIT_HAS_ID)
 	async_wait_id (&(wtp->common), u->au, *wtp->id);
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index c4e1ccb..a3b0656 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -514,12 +514,12 @@ set_internal_unit (st_parameter_dt *dtp, gfc_unit *iunit, int kind)
   iunit->flags.form = FORM_FORMATTED;
   iunit->flags.pad = PAD_YES;
   iunit->flags.status = STATUS_UNSPECIFIED;
-  iunit->flags.sign = SIGN_UNSPECIFIED;
+  iunit->flags.sign = SIGN_PROCDEFINED;
   iunit->flags.decimal = DECIMAL_POINT;
   iunit->flags.delim = DELIM_UNSPECIFIED;
   iunit->flags.encoding = ENCODING_DEFAULT;
   iunit->flags.async = ASYNC_NO;
-  iunit->flags.round = ROUND_UNSPECIFIED;
+  iunit->flags.round = ROUND_PROCDEFINED;
 
   /* Initialize the data transfer parameters.  */
 
@@ -627,12 +627,12 @@ init_units (void)
       u->flags.blank = BLANK_NULL;
       u->flags.pad = PAD_YES;
       u->flags.position = POSITION_ASIS;
-      u->flags.sign = SIGN_UNSPECIFIED;
+      u->flags.sign = SIGN_PROCDEFINED;
       u->flags.decimal = DECIMAL_POINT;
       u->flags.delim = DELIM_UNSPECIFIED;
       u->flags.encoding = ENCODING_DEFAULT;
       u->flags.async = ASYNC_NO;
-      u->flags.round = ROUND_UNSPECIFIED;
+      u->flags.round = ROUND_PROCDEFINED;
       u->flags.share = SHARE_UNSPECIFIED;
       u->flags.cc = CC_LIST;
 
@@ -658,12 +658,12 @@ init_units (void)
       u->flags.status = STATUS_OLD;
       u->flags.blank = BLANK_NULL;
       u->flags.position = POSITION_ASIS;
-      u->flags.sign = SIGN_UNSPECIFIED;
+      u->flags.sign = SIGN_PROCDEFINED;
       u->flags.decimal = DECIMAL_POINT;
       u->flags.delim = DELIM_UNSPECIFIED;
       u->flags.encoding = ENCODING_DEFAULT;
       u->flags.async = ASYNC_NO;
-      u->flags.round = ROUND_UNSPECIFIED;
+      u->flags.round = ROUND_PROCDEFINED;
       u->flags.share = SHARE_UNSPECIFIED;
       u->flags.cc = CC_LIST;
 
@@ -689,11 +689,11 @@ init_units (void)
       u->flags.status = STATUS_OLD;
       u->flags.blank = BLANK_NULL;
       u->flags.position = POSITION_ASIS;
-      u->flags.sign = SIGN_UNSPECIFIED;
+      u->flags.sign = SIGN_PROCDEFINED;
       u->flags.decimal = DECIMAL_POINT;
       u->flags.encoding = ENCODING_DEFAULT;
       u->flags.async = ASYNC_NO;
-      u->flags.round = ROUND_UNSPECIFIED;
+      u->flags.round = ROUND_PROCDEFINED;
       u->flags.share = SHARE_UNSPECIFIED;
       u->flags.cc = CC_LIST;
 
@@ -767,9 +767,12 @@ close_unit_1 (gfc_unit *u, int locked)
 void
 unlock_unit (gfc_unit *u)
 {
-  NOTE ("unlock_unit = %d", u->unit_number);
-  UNLOCK (&u->lock);
-  NOTE ("unlock_unit done");
+  if (u)
+    {
+      NOTE ("unlock_unit = %d", u->unit_number);
+      UNLOCK (&u->lock);
+      NOTE ("unlock_unit done");
+    }
 }
 
 /* close_unit()-- Close a unit.  The stream is closed, and any memory
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 9f02683..346615e 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1178,7 +1178,15 @@ ztoa_big (const char *s, char *buffer, int len, GFC_UINTEGER_LARGEST *n)
 	}
     }
 
+  /* write_z, which calls ztoa_big, is called from transfer.c,
+     formatted_transfer_scalar_write.  There it is passed the kind as
+     argument, which means a maximum of 16.  The buffer is large
+     enough, but the compiler does not know that, so shut up the
+     warning here.  */
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wstringop-overflow"
   *q = '\0';
+#pragma GCC diagnostic pop
 
   if (*n == 0)
     return "0";
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index 75c7942..8a1be05 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -497,7 +497,9 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
       else if (f->u.real.e == 0)
 	{
 	  /* Zero width specified, no leading zeros in exponent  */
-	  if (e > 99 || e < -99)
+	  if (e > 999 || e < -999)
+	    edigits = 6;
+	  else if (e > 99 || e < -99)
 	    edigits = 5;
 	  else if (e > 9 || e < -9)
 	    edigits = 4;