Make STAT and ERRMSG work on ALLOCATE, move error handling to library.

This makes STAT and ERRMSG work on ALLOCATE.  It also separates
the allocation of coarrays into two functions: One without error
checking, which is called by compiler-generated code, and one
with error checking for call from user code.

In the course of looking at this, it was also noticed that
allocatable coarrays were not automatically deallocated;
this is now also fixed.  Also, saved allocatable coarrays
are now saved.

gcc/fortran/ChangeLog:

	* trans-array.c (gfc_allocate_shared_coarray): Remove extra
	arguments, just build the call.
	(allocate_shared_coarray_chk): New function.
	(gfc_array_allocate): Adjust where to set the offset.
	Error handling is done in the library for shared coarrays.
	(gfc_trans_deferred_array): No early return for allocatable
	shared coarrays.
	* trans-array.h (gfc_array_allocate): Adjust prototype.
	(gfc_allocate_shared_coarray): Likewise.
	* trans-decl.c: Rename gfor_fndecl_cas_coarray_allocate to
	gfor_fndecl_cas_coarray_alloc for
	brevity.  Add gfor_fndecl_cas_coarray_alloc_chk.
	(gfc_build_builtin_function_decls): Likewise.
	(gfc_trans_shared_coarray): Adjust calling sequence for
	gfc_allocate_shared_coarray.
	(gfc_trans_deferred_vars): Correct handling of saved
	allocatable shared coarrays.
	* trans-stmt.c (gfc_trans_sync): Adjust whitespace.o
	(coarray_alloc_p): Remove.
	(gfc_trans_allocate): Add shared_coarray variable to adjust
	status and errmsg handling.
	* trans.h: Rename gfor_fndecl_cas_coarray_allocate to
	gfor_fndecl_cas_coarray_alloc for brevity.  Add
	gfor_fndecl_cas_coarray_alloc_chk.

libgfortran/ChangeLog:

	* caf_shared/coarraynative.c (test_for_cas_errors): Correct
	handling of stat.
	* caf_shared/libcoarraynative.h (STAT_ERRMSG_ENTRY_CHECK): Use
	unlikely in condition.
	(STAT_ERRMSG_ENTRY_CHECK_RET): Likewise.
	* caf_shared/wrapper.c (cas_coarray_alloc): Adjust arguments.
	Call cas_coarray_alloc_work.
	(cas_coarray_alloc_chk): New function.
	(cas_coarray_alloc_work): New function.

gcc/testsuite/ChangeLog:

	* gfortran.dg/caf-shared/allocate_1.f90: Adjust number of calls to
	sync_all.
	* gfortran.dg/caf-shared/allocate_status_1.f90: New test.
	* gfortran.dg/caf-shared/automatic_deallocate_1.f90: New test.
	* gfortran.dg/caf-shared/save_allocatable_1.f90: New test.

3 files changed, 100 insertions, 38 deletions

diff --git a/libgfortran/caf_shared/coarraynative.c b/libgfortran/caf_shared/coarraynative.c
index 1f1f396d245..1ae0c4068ce 100644
--- a/libgfortran/caf_shared/coarraynative.c
+++ b/libgfortran/caf_shared/coarraynative.c
@@ -103,45 +103,63 @@ int
 test_for_cas_errors (int *stat, char *errmsg, size_t errmsg_length)
 {
   size_t errmsg_written_bytes;
-  if (!stat)
-    return 0;
 
   /* This rather strange ordering is mandated by the standard.  */
   if (this_image.m->finished_images)
     {
-      *stat = CAS_STAT_STOPPED_IMAGE;
-      if (errmsg)
+      if (stat)
 	{
-	  errmsg_written_bytes = snprintf (errmsg, errmsg_length,
-					   "Stopped images present (currently "
-					   "%d)",
-					   this_image.m->finished_images);
-	  if (errmsg_written_bytes > errmsg_length - 1)
-	    errmsg_written_bytes = errmsg_length - 1;
-
-	  memset (errmsg + errmsg_written_bytes, ' ',
-		  errmsg_length - errmsg_written_bytes);
+	  *stat = CAS_STAT_STOPPED_IMAGE;
+	  if (errmsg)
+	    {
+	      errmsg_written_bytes
+		= snprintf (errmsg, errmsg_length,
+			    "Stopped images present (currently %d)",
+			    this_image.m->finished_images);
+	      if (errmsg_written_bytes > errmsg_length - 1)
+		errmsg_written_bytes = errmsg_length - 1;
+
+	      memset (errmsg + errmsg_written_bytes, ' ',
+		      errmsg_length - errmsg_written_bytes);
+	    }
+	}
+      else
+	{
+	  fprintf (stderr, "Stopped images present (currently %d)",
+		   this_image.m->finished_images);
+	  exit(1);
 	}
     }
   else if (this_image.m->has_failed_image)
     {
-      *stat = CAS_STAT_FAILED_IMAGE;
-      if (errmsg)
+      if (stat)
 	{
-	  errmsg_written_bytes = snprintf (errmsg, errmsg_length,
-					   "Failed images present (currently "
-					   "%d)",
-					   this_image.m->has_failed_image);
-	  if (errmsg_written_bytes > errmsg_length - 1)
-	    errmsg_written_bytes = errmsg_length - 1;
-
-	  memset (errmsg + errmsg_written_bytes, ' ',
-		  errmsg_length - errmsg_written_bytes);
+	  *stat = CAS_STAT_FAILED_IMAGE;
+	  if (errmsg)
+	    {
+	      errmsg_written_bytes
+		= snprintf (errmsg, errmsg_length,
+			    "Failed images present (currently %d)",
+			    this_image.m->has_failed_image);
+	      if (errmsg_written_bytes > errmsg_length - 1)
+		errmsg_written_bytes = errmsg_length - 1;
+
+	      memset (errmsg + errmsg_written_bytes, ' ',
+		      errmsg_length - errmsg_written_bytes);
+	    }
+	}
+      else
+	{
+	  fprintf (stderr, "Failed images present (currently %d)\n",
+		   this_image.m->has_failed_image);
+	  exit(1);
 	}
     }
   else
     {
-      *stat = 0;
+      if (stat)
+	*stat = 0;
+
       return 0;
     }
   return 1;
diff --git a/libgfortran/caf_shared/libcoarraynative.h b/libgfortran/caf_shared/libcoarraynative.h
index e4549652d78..3cc01232519 100644
--- a/libgfortran/caf_shared/libcoarraynative.h
+++ b/libgfortran/caf_shared/libcoarraynative.h
@@ -109,13 +109,13 @@ internal_proto(error_on_missing_images);
 
 #define STAT_ERRMSG_ENTRY_CHECK(stat, errmsg, errmsg_len) \
 	do { \
-	  if (test_for_cas_errors(stat, errmsg, errmsg_len))\
+	  if (unlikely (test_for_cas_errors(stat, errmsg, errmsg_len)))	\
 	    return;\
   	} while(0)
 
 #define STAT_ERRMSG_ENTRY_CHECK_RET(stat, errmsg, errmsg_len, retval) \
 	do { \
-	  if (test_for_cas_errors(stat, errmsg, errmsg_len))\
+	  if (unlikely(test_for_cas_errors(stat, errmsg, errmsg_len)))	\
 	    return retval;\
   	} while(0)
 
diff --git a/libgfortran/caf_shared/wrapper.c b/libgfortran/caf_shared/wrapper.c
index a3d88660f01..05ee838c243 100644
--- a/libgfortran/caf_shared/wrapper.c
+++ b/libgfortran/caf_shared/wrapper.c
@@ -44,10 +44,13 @@ enum gfc_coarray_allocation_type
   GFC_NCA_EVENT_COARRAY,
 };
 
-void cas_coarray_alloc (gfc_array_void *, size_t, int, int, int *,
-			char *, size_t);
+void cas_coarray_alloc (gfc_array_void *, size_t, int, int);
 export_proto (cas_coarray_alloc);
 
+void cas_coarray_alloc_chk (gfc_array_void *, size_t, int, int, int *,
+			    char *, size_t);
+export_proto (cas_coarray_alloc_chk);
+
 void cas_coarray_free (gfc_array_void *, int);
 export_proto (cas_coarray_free);
 
@@ -85,9 +88,9 @@ void cas_collsub_broadcast_scalar (void *restrict, size_t, int, int *, char *,
 				   size_t);
 export_proto (cas_collsub_broadcast_scalar);
 
-void
-cas_coarray_alloc (gfc_array_void *desc, size_t elem_size, int corank,
-		   int alloc_type, int *status, char *errmsg, size_t errmsg_len)
+static void
+cas_coarray_alloc_work (gfc_array_void *desc, size_t elem_size, int corank,
+			int alloc_type)
 {
   int i, last_rank_index;
   int num_coarray_elems, num_elems; /* Excludes the last dimension, because it
@@ -96,10 +99,6 @@ cas_coarray_alloc (gfc_array_void *desc, size_t elem_size, int corank,
   size_t last_lbound;
   size_t size_in_bytes;
 
-  ensure_initialization (); /* This function might be the first one to be
-			       called, if it is called in a constructor.  */
-
-  STAT_ERRMSG_ENTRY_CHECK (status, errmsg, errmsg_len);
   if (alloc_type == GFC_NCA_LOCK_COARRAY)
     elem_size = sizeof (pthread_mutex_t);
   else if (alloc_type == GFC_NCA_EVENT_COARRAY)
@@ -152,8 +151,53 @@ cas_coarray_alloc (gfc_array_void *desc, size_t elem_size, int corank,
   else if (alloc_type == GFC_NCA_EVENT_COARRAY)
     (void)0; // TODO
   else
-    desc->base_addr
-	= get_memory_by_id (&local->ai, size_in_bytes, (intptr_t)desc);
+    desc->base_addr =
+      get_memory_by_id (&local->ai, size_in_bytes, (intptr_t) desc);
+}
+
+void
+cas_coarray_alloc (gfc_array_void *desc, size_t elem_size, int corank,
+		   int alloc_type)
+{
+  ensure_initialization (); /* This function might be the first one to be
+			       called, if it is called in a constructor.  */
+  cas_coarray_alloc_work (desc, elem_size, corank, alloc_type);
+}
+
+void
+cas_coarray_alloc_chk (gfc_array_void *desc, size_t elem_size, int corank,
+		       int alloc_type, int *status, char *errmsg,
+		       size_t errmsg_len)
+{
+  STAT_ERRMSG_ENTRY_CHECK (status, errmsg, errmsg_len);
+  if (unlikely(GFC_DESCRIPTOR_DATA (desc) != NULL))
+    {
+      if (status == NULL)
+	{
+	  fprintf (stderr,"Image %d: Attempting to allocate already allocated "
+		   "variable at %p %p\n", this_image.image_num + 1, (void *) desc,
+		   desc->base_addr);
+	  exit (1);
+	}
+      else
+	{
+	  *status = LIBERROR_ALLOCATION;
+	  if (errmsg)
+	    {
+	      size_t errmsg_written_bytes;
+	      errmsg_written_bytes
+		= snprintf (errmsg, errmsg_len, "Attempting to allocate already "
+			    "allocated variable");
+	      if (errmsg_written_bytes > errmsg_len - 1)
+		errmsg_written_bytes = errmsg_len - 1;
+	      memset (errmsg + errmsg_written_bytes, ' ',
+		      errmsg_len - errmsg_written_bytes);
+	    }
+	  return;
+	}
+    }
+  cas_coarray_alloc_work (desc, elem_size, corank, alloc_type);
+  sync_all (&local->si);
 }
 
 void