Correctly handle deallocation of components.

gcc/fortran/ChangeLog:

	* trans-decl.c (gfc_build_builtin_function_decls): Fix types, add some
	documentation.
	(gfc_trans_native_coarray): Fix call.
	* trans.c (gfc_deallocate_with_status): Correctly handle deallocation
	of components.

2 files changed, 32 insertions, 10 deletions

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index c5d7fab..5eadf40 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4106,15 +4106,19 @@ gfc_build_builtin_function_decls (void)
 	pvoid_type_node, integer_type_node, integer_type_node, integer_type_node,
 	NULL_TREE);
       gfor_fndecl_nca_coarray_free = gfc_build_library_function_decl_with_spec (
-	 get_identifier (PREFIX("nca_coarray_free")), "..RR", integer_type_node, 3,
-	pvoid_type_node, integer_type_node, integer_type_node, NULL_TREE);
+	 get_identifier (PREFIX("nca_coarray_free")), "..R", integer_type_node, 2,
+	 pvoid_type_node, /* Pointer to the descriptor to be deallocated.  */
+	 integer_type_node, /* Type of allocation (normal, event, lock).  */
+	NULL_TREE);
       gfor_fndecl_nca_this_image = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("nca_coarray_this_image")), ".X", integer_type_node, 1,
-	integer_type_node, NULL_TREE);
+	integer_type_node, /* This is the team number.  Currently ignored.  */
+	NULL_TREE);
       DECL_PURE_P (gfor_fndecl_nca_this_image) = 1;
       gfor_fndecl_nca_num_images = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("nca_coarray_num_images")), ".X", integer_type_node, 1,
-	integer_type_node, NULL_TREE);
+	integer_type_node, /* See above.  */
+	NULL_TREE);
       DECL_PURE_P (gfor_fndecl_nca_num_images) = 1;
       gfor_fndecl_nca_sync_all = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("nca_coarray_sync_all")), ".X", void_type_node, 1,
@@ -4663,9 +4667,7 @@ gfc_trans_native_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol *
     {
       tmp = build_call_expr_loc (input_location, gfor_fndecl_nca_coarray_free,
 				2, gfc_build_addr_expr (pvoid_type_node, decl),
-				build_int_cst (integer_type_node, alloc_type),
-				build_int_cst (integer_type_node,
-				sym->as->corank));
+				build_int_cst (integer_type_node, alloc_type));
       gfc_add_expr_to_block (cleanup, tmp);
     }
 }
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 2b60550..1bd9801 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -33,6 +33,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "trans-array.h"
 #include "trans-types.h"
 #include "trans-const.h"
+#include "diagnostic-core.h"
 
 /* Naming convention for backend interface code:
 
@@ -1351,9 +1352,10 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
   tree cond, tmp, error;
   tree status_type = NULL_TREE;
   tree token = NULL_TREE;
+  tree orig_desc;
   gfc_coarray_deregtype caf_dereg_type = GFC_CAF_COARRAY_DEREGISTER;
 
-  if (coarray_dealloc_mode >= GFC_CAF_COARRAY_ANALYZE)
+  if (coarray_dealloc_mode >= GFC_CAF_COARRAY_ANALYZE )
     {
       if (flag_coarray == GFC_FCOARRAY_LIB)
 	{
@@ -1374,7 +1376,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
 		{
 		  gcc_assert (GFC_ARRAY_TYPE_P (caf_type)
 			      && GFC_TYPE_ARRAY_CAF_TOKEN (caf_type)
-				 != NULL_TREE);
+			      != NULL_TREE);
 		  token = GFC_TYPE_ARRAY_CAF_TOKEN (caf_type);
 		}
 	    }
@@ -1390,6 +1392,11 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
 	  else
 	    caf_dereg_type = (enum gfc_coarray_deregtype) coarray_dealloc_mode;
 	}
+      else if (flag_coarray == GFC_FCOARRAY_NATIVE)
+	{
+	  orig_desc = pointer;
+	  pointer = gfc_conv_descriptor_data_get (pointer);
+	}
       else if (flag_coarray == GFC_FCOARRAY_SINGLE)
 	pointer = gfc_conv_descriptor_data_get (pointer);
     }
@@ -1441,7 +1448,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
     gfc_add_expr_to_block (&non_null, add_when_allocated);
   gfc_add_finalizer_call (&non_null, expr);
   if (coarray_dealloc_mode == GFC_CAF_COARRAY_NOCOARRAY
-      || flag_coarray != GFC_FCOARRAY_LIB)
+      || (flag_coarray != GFC_FCOARRAY_LIB && flag_coarray != GFC_FCOARRAY_NATIVE))
     {
       tmp = build_call_expr_loc (input_location,
 				 builtin_decl_explicit (BUILT_IN_FREE), 1,
@@ -1469,6 +1476,19 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
 	  gfc_add_expr_to_block (&non_null, tmp);
 	}
     }
+  else if (flag_coarray == GFC_FCOARRAY_NATIVE
+	   && coarray_dealloc_mode >= GFC_CAF_COARRAY_ANALYZE)
+    {
+      tmp = build_call_expr_loc(input_location, gfor_fndecl_nca_coarray_free,
+				2, gfc_build_addr_expr (pvoid_type_node, orig_desc),
+				build_int_cst(integer_type_node, GFC_NCA_NORMAL_COARRAY));
+      gfc_add_expr_to_block (&non_null, tmp);
+      gfc_add_modify (&non_null, pointer, build_int_cst (TREE_TYPE (pointer),
+							 0));
+
+      if (status != NULL_TREE && !integer_zerop(status))
+	sorry("Status not yet implemented");
+    }
   else
     {
       tree cond2, pstat = null_pointer_node;