Merge from trunk revision fba228e259dd5112851527f2dbb62c5601100985.

1 files changed, 139 insertions, 27 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0d013de..e2f59e0 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5104,7 +5104,6 @@ set_loop_bounds (gfc_loopinfo *loop)
 
 	  if (info->shape)
 	    {
-	      gcc_assert (info->shape[dim]);
 	      /* The frontend has worked out the size for us.  */
 	      if (!loopspec[n]
 		  || !specinfo->shape
@@ -7901,31 +7900,143 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   gfc_cleanup_loop (&loop);
 }
 
+
+/* Calculate the array size (number of elements); if dim != NULL_TREE,
+   return size for that dim (dim=0..rank-1; only for GFC_DESCRIPTOR_TYPE_P).  */
+tree
+gfc_tree_array_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree dim)
+{
+  if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
+    {
+      gcc_assert (dim == NULL_TREE);
+      return GFC_TYPE_ARRAY_SIZE (TREE_TYPE (desc));
+    }
+  tree size, tmp, rank = NULL_TREE, cond = NULL_TREE;
+  symbol_attribute attr = gfc_expr_attr (expr);
+  gfc_array_spec *as = gfc_get_full_arrayspec_from_expr (expr);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
+  if ((!attr.pointer && !attr.allocatable && as && as->type == AS_ASSUMED_RANK)
+       || !dim)
+    {
+      if (expr->rank < 0)
+	rank = fold_convert (signed_char_type_node,
+			     gfc_conv_descriptor_rank (desc));
+      else
+	rank = build_int_cst (signed_char_type_node, expr->rank);
+    }
+
+  if (dim || expr->rank == 1)
+    {
+      if (!dim)
+	dim = gfc_index_zero_node;
+      tree ubound = gfc_conv_descriptor_ubound_get (desc, dim);
+      tree lbound = gfc_conv_descriptor_lbound_get (desc, dim);
+
+      size = fold_build2_loc (input_location, MINUS_EXPR,
+			      gfc_array_index_type, ubound, lbound);
+      size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			      size, gfc_index_one_node);
+      /* if (!allocatable && !pointer && assumed rank)
+	   size = (idx == rank && ubound[rank-1] == -1 ? -1 : size;
+	 else
+	   size = max (0, size);  */
+      size = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type,
+			      size, gfc_index_zero_node);
+      if (!attr.pointer && !attr.allocatable
+	  && as && as->type == AS_ASSUMED_RANK)
+	{
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node,
+				 rank, build_int_cst (signed_char_type_node, 1));
+	  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				  fold_convert (signed_char_type_node, dim),
+				  tmp);
+	  tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				 gfc_conv_descriptor_ubound_get (desc, dim),
+				 build_int_cst (gfc_array_index_type, -1));
+	  cond = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node,
+				  cond, tmp);
+	  tmp = build_int_cst (gfc_array_index_type, -1);
+	  size = build3_loc (input_location, COND_EXPR, gfc_array_index_type,
+			     cond, tmp, size);
+	}
+      return size;
+    }
+
+  /* size = 1. */
+  size = gfc_create_var (gfc_array_index_type, "size");
+  gfc_add_modify (block, size, build_int_cst (TREE_TYPE (size), 1));
+  tree extent = gfc_create_var (gfc_array_index_type, "extent");
+
+  stmtblock_t cond_block, loop_body;
+  gfc_init_block (&cond_block);
+  gfc_init_block (&loop_body);
+
+  /* Loop: for (i = 0; i < rank; ++i).  */
+  tree idx = gfc_create_var (signed_char_type_node, "idx");
+  /* Loop body.  */
+  /* #if (assumed-rank + !allocatable && !pointer)
+       if (idx == rank - 1 && dim[idx].ubound == -1)
+	 extent = -1;
+       else
+     #endif
+	 extent = gfc->dim[i].ubound - gfc->dim[i].lbound + 1
+	 if (extent < 0)
+	   extent = 0
+      size *= extent.  */
+  cond = NULL_TREE;
+  if (!attr.pointer && !attr.allocatable && as && as->type == AS_ASSUMED_RANK)
+    {
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node,
+			     rank, build_int_cst (signed_char_type_node, 1));
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				  idx, tmp);
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			     gfc_conv_descriptor_ubound_get (desc, idx),
+			     build_int_cst (gfc_array_index_type, -1));
+      cond = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node,
+			      cond, tmp);
+    }
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			 gfc_conv_descriptor_ubound_get (desc, idx),
+			 gfc_conv_descriptor_lbound_get (desc, idx));
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			 tmp, gfc_index_one_node);
+  gfc_add_modify (&cond_block, extent, tmp);
+  tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			 extent, gfc_index_zero_node);
+  tmp = build3_v (COND_EXPR, tmp,
+		  fold_build2_loc (input_location, MODIFY_EXPR,
+				   gfc_array_index_type,
+				   extent, gfc_index_zero_node),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&cond_block, tmp);
+  tmp = gfc_finish_block (&cond_block);
+  if (cond)
+    tmp = build3_v (COND_EXPR, cond,
+		    fold_build2_loc (input_location, MODIFY_EXPR,
+				     gfc_array_index_type, extent,
+				     build_int_cst (gfc_array_index_type, -1)),
+		    tmp);
+   gfc_add_expr_to_block (&loop_body, tmp);
+   /* size *= extent.  */
+   gfc_add_modify (&loop_body, size,
+		   fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+				    size, extent));
+  /* Generate loop. */
+  gfc_simple_for_loop (block, idx, build_int_cst (TREE_TYPE (idx), 0), rank, LT_EXPR,
+		       build_int_cst (TREE_TYPE (idx), 1),
+		       gfc_finish_block (&loop_body));
+  return size;
+}
+
 /* Helper function for gfc_conv_array_parameter if array size needs to be
    computed.  */
 
 static void
-array_parameter_size (tree desc, gfc_expr *expr, tree *size)
+array_parameter_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree *size)
 {
   tree elem;
-  if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
-    *size = GFC_TYPE_ARRAY_SIZE (TREE_TYPE (desc));
-  else if (expr->rank > 1)
-    *size = build_call_expr_loc (input_location,
-			     gfor_fndecl_size0, 1,
-			     gfc_build_addr_expr (NULL, desc));
-  else
-    {
-      tree ubound = gfc_conv_descriptor_ubound_get (desc, gfc_index_zero_node);
-      tree lbound = gfc_conv_descriptor_lbound_get (desc, gfc_index_zero_node);
-
-      *size = fold_build2_loc (input_location, MINUS_EXPR,
-			       gfc_array_index_type, ubound, lbound);
-      *size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-			       *size, gfc_index_one_node);
-      *size = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type,
-			       *size, gfc_index_zero_node);
-    }
+  *size = gfc_tree_array_size (block, desc, expr, NULL);
   elem = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
   *size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
 			   *size, fold_convert (gfc_array_index_type, elem));
@@ -8035,7 +8146,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
           else
 	    se->expr = gfc_build_addr_expr (NULL_TREE, tmp);
 	  if (size)
-	    array_parameter_size (tmp, expr, size);
+	    array_parameter_size (&se->pre, tmp, expr, size);
 	  return;
         }
 
@@ -8047,7 +8158,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
 	      tmp = se->expr;
 	    }
 	  if (size)
-	    array_parameter_size (tmp, expr, size);
+	    array_parameter_size (&se->pre, tmp, expr, size);
 	  se->expr = gfc_conv_array_data (tmp);
           return;
         }
@@ -8122,7 +8233,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
       if (expr->ts.type == BT_CHARACTER && expr->expr_type != EXPR_FUNCTION)
 	se->string_length = expr->ts.u.cl->backend_decl;
       if (size)
-	array_parameter_size (se->expr, expr, size);
+	array_parameter_size (&se->pre, se->expr, expr, size);
       se->expr = gfc_conv_array_data (se->expr);
       return;
     }
@@ -8132,7 +8243,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
       /* Result of the enclosing function.  */
       gfc_conv_expr_descriptor (se, expr);
       if (size)
-	array_parameter_size (se->expr, expr, size);
+	array_parameter_size (&se->pre, se->expr, expr, size);
       se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
 
       if (g77 && TREE_TYPE (TREE_TYPE (se->expr)) != NULL_TREE
@@ -8149,9 +8260,10 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
       gfc_conv_expr_descriptor (se, expr);
 
       if (size)
-	array_parameter_size (build_fold_indirect_ref_loc (input_location,
-						       se->expr),
-				  expr, size);
+	array_parameter_size (&se->pre,
+			      build_fold_indirect_ref_loc (input_location,
+							    se->expr),
+			      expr, size);
     }
 
   /* Deallocate the allocatable components of structures that are