Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 176528)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -4384,3 +4384,4 @@ gfc_array_init_size (tree descriptor, in
 bool
-gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
+gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
+		    tree errlen)
 {
@@ -4479,18 +4480,11 @@ gfc_array_allocate (gfc_se * se, gfc_exp
 
-  if (pstat != NULL_TREE && !integer_zerop (pstat))
-    {
-      /* Set the status variable if it's present.  */
+  if (status != NULL_TREE)
+    {
+      tree status_type = TREE_TYPE (status);
       stmtblock_t set_status_block;
-      tree status_type = pstat ? TREE_TYPE (TREE_TYPE (pstat)) : NULL_TREE;
 
       gfc_start_block (&set_status_block);
-      gfc_add_modify (&set_status_block,
-  		      fold_build1_loc (input_location, INDIRECT_REF,
-  				       status_type, pstat),
-  			   build_int_cst (status_type, LIBERROR_ALLOCATION));
-
-      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
-  			     pstat, build_int_cst (TREE_TYPE (pstat), 0));
-      error = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp,
-  			       error, gfc_finish_block (&set_status_block));
+      gfc_add_modify (&set_status_block, status,
+		      build_int_cst (status_type, LIBERROR_ALLOCATION));
+      error = gfc_finish_block (&set_status_block);
     }
@@ -4503,10 +4497,11 @@ gfc_array_allocate (gfc_se * se, gfc_exp
 
-  /* The allocate_array variants take the old pointer as first argument.  */
+  /* The allocatable variant takes the old pointer as first argument.  */
   if (allocatable)
-    tmp = gfc_allocate_allocatable_with_status (&elseblock,
-						pointer, size, pstat, expr);
+    tmp = gfc_allocate_allocatable (&elseblock, pointer, size,
+				    status, errmsg, errlen, expr);
   else
-    tmp = gfc_allocate_with_status (&elseblock, size, pstat, false);
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, pointer,
-			 tmp);
+    tmp = gfc_allocate_using_malloc (&elseblock, size, status);
+
+  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			 pointer, tmp);
 
Index: gcc/fortran/trans-array.h
===================================================================
--- gcc/fortran/trans-array.h	(revision 176528)
+++ gcc/fortran/trans-array.h	(working copy)
@@ -26,3 +26,3 @@ tree gfc_array_deallocate (tree, tree, g
    se, which should contain an expression for the array descriptor.  */
-bool gfc_array_allocate (gfc_se *, gfc_expr *, tree);
+bool gfc_array_allocate (gfc_se *, gfc_expr *, tree, tree, tree);
 
Index: gcc/fortran/trans-openmp.c
===================================================================
--- gcc/fortran/trans-openmp.c	(revision 176528)
+++ gcc/fortran/trans-openmp.c	(working copy)
@@ -190,5 +190,5 @@ gfc_omp_clause_default_ctor (tree clause
   size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block);
-  ptr = gfc_allocate_allocatable_with_status (&cond_block,
-					      build_int_cst (pvoid_type_node, 0),
-					      size, NULL, NULL);
+  ptr = gfc_allocate_allocatable (&cond_block,
+			  build_int_cst (pvoid_type_node, 0),
+			  size, NULL_TREE, NULL_TREE, NULL_TREE, NULL);
   gfc_conv_descriptor_data_set (&cond_block, decl, ptr);
@@ -243,5 +243,5 @@ gfc_omp_clause_copy_ctor (tree clause, t
   size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
-  ptr = gfc_allocate_allocatable_with_status (&block,
-					      build_int_cst (pvoid_type_node, 0),
-					      size, NULL, NULL);
+  ptr = gfc_allocate_allocatable (&block,
+			  build_int_cst (pvoid_type_node, 0),
+			  size, NULL_TREE, NULL_TREE, NULL_TREE, NULL);
   gfc_conv_descriptor_data_set (&block, dest, ptr);
@@ -665,5 +665,5 @@ gfc_trans_omp_array_reduction (tree c, g
       size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
-      ptr = gfc_allocate_allocatable_with_status (&block,
-						  build_int_cst (pvoid_type_node, 0),
-						  size, NULL, NULL);
+      ptr = gfc_allocate_allocatable (&block,
+			      build_int_cst (pvoid_type_node, 0),
+			      size, NULL_TREE, NULL_TREE, NULL_TREE, NULL);
       gfc_conv_descriptor_data_set (&block, decl, ptr);
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(revision 176528)
+++ gcc/fortran/trans-stmt.c	(working copy)
@@ -4688,4 +4688,6 @@ gfc_trans_allocate (gfc_code * code)
   tree stat;
-  tree pstat;
-  tree error_label;
+  tree errmsg;
+  tree errlen;
+  tree label_errmsg;
+  tree label_finish;
   tree memsz;
@@ -4701,3 +4703,4 @@ gfc_trans_allocate (gfc_code * code)
 
-  pstat = stat = error_label = tmp = memsz = NULL_TREE;
+  stat = tmp = memsz = NULL_TREE;
+  label_errmsg = label_finish = errmsg = errlen = NULL_TREE;
 
@@ -4709,9 +4712,23 @@ gfc_trans_allocate (gfc_code * code)
     {
+      /* STAT=  */
       tree gfc_int4_type_node = gfc_get_int_type (4);
-
       stat = gfc_create_var (gfc_int4_type_node, "stat");
-      pstat = gfc_build_addr_expr (NULL_TREE, stat);
-
-      error_label = gfc_build_label_decl (NULL_TREE);
-      TREE_USED (error_label) = 1;
+
+      /* ERRMSG=  */
+      errmsg = null_pointer_node;
+      errlen = build_int_cst (gfc_charlen_type_node, 0);
+      if (code->expr2)
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr_lhs (&se, code->expr2);
+
+	  errlen = gfc_get_expr_charlen (code->expr2);
+	  errmsg = gfc_build_addr_expr (pchar_type_node, se.expr);
+	}
+
+      /* GOTO destinations.  */
+      label_errmsg = gfc_build_label_decl (NULL_TREE);
+      label_finish = gfc_build_label_decl (NULL_TREE);
+      TREE_USED (label_errmsg) = 1;
+      TREE_USED (label_finish) = 1;
     }
@@ -4734,3 +4751,3 @@ gfc_trans_allocate (gfc_code * code)
 
-      if (!gfc_array_allocate (&se, expr, pstat))
+      if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen))
 	{
@@ -4849,6 +4866,6 @@ gfc_trans_allocate (gfc_code * code)
 	  if (gfc_expr_attr (expr).allocatable)
-	    tmp = gfc_allocate_allocatable_with_status (&se.pre, se.expr, memsz,
-							pstat, expr);
+	    tmp = gfc_allocate_allocatable (&se.pre, se.expr, memsz,
+					    stat, errmsg, errlen, expr);
 	  else
-	    tmp = gfc_allocate_with_status (&se.pre, memsz, pstat, false);
+	    tmp = gfc_allocate_using_malloc (&se.pre, memsz, stat);
 
@@ -4861,3 +4878,9 @@ gfc_trans_allocate (gfc_code * code)
 	    {
-	      tmp = build1_v (GOTO_EXPR, error_label);
+	      /* The coarray library already sets the errmsg.  */
+	      if (gfc_option.coarray == GFC_FCOARRAY_LIB
+		  && gfc_expr_attr (expr).codimension)
+		tmp = build1_v (GOTO_EXPR, label_finish);
+	      else
+		tmp = build1_v (GOTO_EXPR, label_errmsg);
+
 	      parm = fold_build2_loc (input_location, NE_EXPR,
@@ -5007,12 +5030,7 @@ gfc_trans_allocate (gfc_code * code)
 
-  /* STAT block.  */
-  if (code->expr1)
+  /* STAT or ERRMSG.  */
+  if (code->expr1 || code->expr2)
     {
-      tmp = build1_v (LABEL_EXPR, error_label);
+      tmp = build1_v (LABEL_EXPR, label_errmsg);
       gfc_add_expr_to_block (&block, tmp);
-
-      gfc_init_se (&se, NULL);
-      gfc_conv_expr_lhs (&se, code->expr1);
-      tmp = convert (TREE_TYPE (se.expr), stat);
-      gfc_add_modify (&block, se.expr, tmp);
     }
@@ -5024,3 +5042,3 @@ gfc_trans_allocate (gfc_code * code)
       const char *msg = "Attempt to allocate an allocated object";
-      tree errmsg, slen, dlen;
+      tree slen, dlen;
 
@@ -5052,2 +5070,18 @@ gfc_trans_allocate (gfc_code * code)
 
+  /* STAT or ERRMSG.  */
+  if (code->expr1 || code->expr2)
+    {
+      tmp = build1_v (LABEL_EXPR, label_finish);
+      gfc_add_expr_to_block (&block, tmp);
+    }
+
+  /* STAT block.  */
+  if (code->expr1)
+    {
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_lhs (&se, code->expr1);
+      tmp = convert (TREE_TYPE (se.expr), stat);
+      gfc_add_modify (&block, se.expr, tmp);
+    }
+
   gfc_add_block_to_block (&block, &se.post);
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c	(revision 176528)
+++ gcc/fortran/trans.c	(working copy)
@@ -567,3 +567,3 @@ gfc_call_malloc (stmtblock_t * block, tr
     void *
-    allocate (size_t size, integer_type* stat)
+    allocate (size_t size, integer_type stat)
     {
@@ -571,4 +571,4 @@ gfc_call_malloc (stmtblock_t * block, tr
     
-      if (stat)
-	*stat = 0;
+      if (stat requested)
+	stat = 0;
 
@@ -585,8 +585,7 @@ gfc_call_malloc (stmtblock_t * block, tr
 tree
-gfc_allocate_with_status (stmtblock_t * block, tree size, tree status,
-			  bool coarray_lib)
+gfc_allocate_using_malloc (stmtblock_t * block, tree size, tree status)
 {
   stmtblock_t alloc_block;
-  tree res, tmp, msg, cond;
-  tree status_type = status ? TREE_TYPE (TREE_TYPE (status)) : NULL_TREE;
+  tree res, tmp, on_error;
+  tree status_type = status ? TREE_TYPE (status) : NULL_TREE;
 
@@ -601,15 +600,6 @@ gfc_allocate_with_status (stmtblock_t * 
   /* Set the optional status variable to zero.  */
-  if (status != NULL_TREE && !integer_zerop (status))
-    {
-      tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
-			     fold_build1_loc (input_location, INDIRECT_REF,
-					      status_type, status),
-			     build_int_cst (status_type, 0));
-      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
-			     fold_build2_loc (input_location, NE_EXPR,
-					boolean_type_node, status,
-					build_int_cst (TREE_TYPE (status), 0)),
-			     tmp, build_empty_stmt (input_location));
-      gfc_add_expr_to_block (block, tmp);
-    }
+  if (status != NULL_TREE)
+      gfc_add_expr_to_block (block,
+	     fold_build2_loc (input_location, MODIFY_EXPR, status_type,
+			      status, build_int_cst (status_type, 0)));
 
@@ -617,48 +607,19 @@ gfc_allocate_with_status (stmtblock_t * 
   gfc_start_block (&alloc_block);
-  if (coarray_lib)
-    {
-      gfc_add_modify (&alloc_block, res,
-	      fold_convert (prvoid_type_node,
-		    build_call_expr_loc (input_location,
-			 gfor_fndecl_caf_register, 6,
-			 fold_build2_loc (input_location,
-				  MAX_EXPR, size_type_node, size,
-				  build_int_cst (size_type_node, 1)),
-			 build_int_cst (integer_type_node,
-					GFC_CAF_COARRAY_ALLOC),
-			 null_pointer_node,  /* token  */
-			 null_pointer_node,  /* stat  */
-			 null_pointer_node,  /* errmsg, errmsg_len  */
-			 build_int_cst (integer_type_node, 0))));
-    }
+  gfc_add_modify (&alloc_block, res,
+	  fold_convert (prvoid_type_node,
+		build_call_expr_loc (input_location,
+			     built_in_decls[BUILT_IN_MALLOC], 1,
+			     fold_build2_loc (input_location,
+				      MAX_EXPR, size_type_node, size,
+				      build_int_cst (size_type_node, 1)))));
+
+  /* What to do in case of error.  */
+  if (status != NULL_TREE)
+    on_error = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
+			status, build_int_cst (status_type, LIBERROR_ALLOCATION));
   else
-    {
-      gfc_add_modify (&alloc_block, res,
-	      fold_convert (prvoid_type_node,
-		    build_call_expr_loc (input_location,
-			 built_in_decls[BUILT_IN_MALLOC], 1,
-			 fold_build2_loc (input_location,
-				  MAX_EXPR, size_type_node, size,
-				  build_int_cst (size_type_node, 1)))));
-    }
-
-  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
-			     ("Allocation would exceed memory limit"));
-  tmp = build_call_expr_loc (input_location,
-			 gfor_fndecl_os_error, 1, msg);
-
-  if (status != NULL_TREE && !integer_zerop (status))
-    {
-      /* Set the status variable if it's present.  */
-      tree tmp2;
-
-      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
-			      status, build_int_cst (TREE_TYPE (status), 0));
-      tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
-			      fold_build1_loc (input_location, INDIRECT_REF,
-					       status_type, status),
-			      build_int_cst (status_type, LIBERROR_ALLOCATION));
-      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
-			     tmp, tmp2);
-    }
+    on_error = build_call_expr_loc (input_location, gfor_fndecl_os_error, 1,
+		    gfc_build_addr_expr (pchar_type_node,
+				 gfc_build_localized_cstring_const
+				 ("Allocation would exceed memory limit")));
 
@@ -668,3 +629,4 @@ gfc_allocate_with_status (stmtblock_t * 
 					  build_int_cst (prvoid_type_node, 0)),
-			 tmp, build_empty_stmt (input_location));
+			 on_error, build_empty_stmt (input_location));
+
   gfc_add_expr_to_block (&alloc_block, tmp);
@@ -676,2 +638,72 @@ gfc_allocate_with_status (stmtblock_t * 
 
+/* Allocate memory, using an optional status argument.
+ 
+   This function follows the following pseudo-code:
+
+    void *
+    allocate (size_t size, integer_type stat)
+    {
+      void *newmem;
+    
+      if (stat requested)
+	stat = 0;
+
+      newmem = _caf_register ( size, regtype, NULL, &stat, NULL, NULL);
+      if (newmem == NULL)
+      {
+        if (!stat requested)
+	  runtime_error ("Allocation would exceed memory limit");
+      }
+      return newmem;
+    }  */
+tree
+gfc_allocate_using_lib (stmtblock_t * block, tree size, tree status,
+			tree errmsg, tree errlen)
+{
+  tree res, pstat;
+  tree status_type = status ? TREE_TYPE (status) : NULL_TREE;
+
+  /* Evaluate size only once, and make sure it has the right type.  */
+  size = gfc_evaluate_now (size, block);
+  if (TREE_TYPE (size) != TREE_TYPE (size_type_node))
+    size = fold_convert (size_type_node, size);
+
+  /* Create a variable to hold the result.  */
+  res = gfc_create_var (prvoid_type_node, NULL);
+
+  /* Set the optional status variable to zero.  */
+  if (status != NULL_TREE)
+      gfc_add_expr_to_block (block,
+	     fold_build2_loc (input_location, MODIFY_EXPR, status_type,
+			      status, build_int_cst (status_type, 0)));
+
+  /* The allocation itself.  */
+  if (status == NULL_TREE)
+    pstat  = null_pointer_node;
+  else
+    pstat  = gfc_build_addr_expr (NULL_TREE, status);
+
+  if (errmsg == NULL_TREE)
+    {
+      gcc_assert(errlen == NULL_TREE);
+      errmsg = null_pointer_node;
+      errlen = build_int_cst (integer_type_node, 0);
+    }
+
+  gfc_add_modify (block, res,
+	  fold_convert (prvoid_type_node,
+		build_call_expr_loc (input_location,
+		     gfor_fndecl_caf_register, 6,
+		     fold_build2_loc (input_location,
+			      MAX_EXPR, size_type_node, size,
+			      build_int_cst (size_type_node, 1)),
+		     build_int_cst (integer_type_node,
+			    GFC_CAF_COARRAY_ALLOC),
+		     null_pointer_node,  /* token  */
+		     pstat, errmsg, errlen)));
+
+  return res;
+}
+
+
 /* Generate code for an ALLOCATE statement when the argument is an
@@ -683,3 +715,3 @@ gfc_allocate_with_status (stmtblock_t * 
     void *
-    allocate_allocatable (void *mem, size_t size, integer_type *stat)
+    allocate_allocatable (void *mem, size_t size, integer_type stat)
     {
@@ -693,3 +725,3 @@ gfc_allocate_with_status (stmtblock_t * 
 	  mem = allocate (size, stat);
-	  *stat = LIBERROR_ALLOCATION;
+	  stat = LIBERROR_ALLOCATION;
 	  return mem;
@@ -704,4 +736,4 @@ gfc_allocate_with_status (stmtblock_t * 
 tree
-gfc_allocate_allocatable_with_status (stmtblock_t * block, tree mem, tree size,
-				      tree status, gfc_expr* expr)
+gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree status,
+			  tree errmsg, tree errlen, gfc_expr* expr)
 {
@@ -720,7 +752,12 @@ gfc_allocate_allocatable_with_status (st
 
-  /* If mem is NULL, we call gfc_allocate_with_status.  */
+  /* If mem is NULL, we call gfc_allocate_using_malloc or
+     gfc_allocate_using_lib.  */
   gfc_start_block (&alloc_block);
-  tmp = gfc_allocate_with_status (&alloc_block, size, status,
-				  gfc_option.coarray == GFC_FCOARRAY_LIB
-				  && gfc_expr_attr (expr).codimension);
+
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB
+      && gfc_expr_attr (expr).codimension)
+    tmp = gfc_allocate_using_lib (&alloc_block, size, status,
+				  errmsg, errlen);
+  else
+    tmp = gfc_allocate_using_malloc (&alloc_block, size, status);
 
@@ -749,5 +786,5 @@ gfc_allocate_allocatable_with_status (st
 
-  if (status != NULL_TREE && !integer_zerop (status))
+  if (status != NULL_TREE)
     {
-      tree status_type = TREE_TYPE (TREE_TYPE (status));
+      tree status_type = TREE_TYPE (status);
       stmtblock_t set_status_block;
@@ -760,14 +797,8 @@ gfc_allocate_allocatable_with_status (st
 
-      tmp = gfc_allocate_with_status (&set_status_block, size, status, false);
+      tmp = gfc_allocate_using_malloc (&set_status_block, size, status);
       gfc_add_modify (&set_status_block, res, fold_convert (type, tmp));
 
-      gfc_add_modify (&set_status_block,
-			   fold_build1_loc (input_location, INDIRECT_REF,
-					    status_type, status),
-			   build_int_cst (status_type, LIBERROR_ALLOCATION));
-
-      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
-			     status, build_int_cst (status_type, 0));
-      error = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp,
-			       error, gfc_finish_block (&set_status_block));
+      gfc_add_modify (&set_status_block, status,
+		      build_int_cst (status_type, LIBERROR_ALLOCATION));
+      error = gfc_finish_block (&set_status_block);
     }
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h	(revision 176528)
+++ gcc/fortran/trans.h	(working copy)
@@ -543,7 +543,8 @@ tree gfc_build_memcpy_call (tree, tree, 
 /* Allocate memory for allocatable variables, with optional status variable.  */
-tree gfc_allocate_allocatable_with_status (stmtblock_t*,
-					   tree, tree, tree, gfc_expr*);
+tree gfc_allocate_allocatable (stmtblock_t*, tree, tree,
+			       tree, tree, tree, gfc_expr*);
 
 /* Allocate memory, with optional status variable.  */
-tree gfc_allocate_with_status (stmtblock_t *, tree, tree, bool);
+tree gfc_allocate_using_malloc (stmtblock_t *, tree, tree);
+tree gfc_allocate_using_lib (stmtblock_t *, tree, tree, tree, tree);
 
