Fortran: Fix assumed-size to assumed-rank passing [PR94070]

This code inlines the size0 and size1 libgfortran calls, the former is still
used by libgfortan itself (and by old code). Besides permitting more
optimizations, it also permits to handle assumed-rank dummies better: If the
dummy argument is a nonpointer/nonallocatable, an assumed-size actual arg is
repesented by having ubound == -1 for the last dimension. However, for
allocatable/pointers, this value can also exist. Hence, the dummy arg attr
has to be honored.

For that reason, when calling an assumed-rank procedure with nonpointer,
nonallocatable dummy arguments, the bounds have to be updated to avoid
the case ubound == -1 for the last dimension.

	PR fortran/94070

gcc/fortran/ChangeLog:

	* trans-array.c (gfc_tree_array_size): New function to
	find size inline (whole array or one dimension).
	(array_parameter_size): Use it, take stmt_block as arg.
	(gfc_conv_array_parameter): Update call.
	* trans-array.h (gfc_tree_array_size): Add prototype.
	* trans-decl.c (gfor_fndecl_size0, gfor_fndecl_size1): Remove
	these global vars.
	(gfc_build_intrinsic_function_decls): Remove their initialization.
	* trans-expr.c (gfc_conv_procedure_call): Update
	bounds of pointer/allocatable actual args to nonallocatable/nonpointer
	dummies to be one based.
	* trans-intrinsic.c (gfc_conv_intrinsic_shape): Fix case for
	assumed rank with allocatable/pointer dummy.
	(gfc_conv_intrinsic_size): Update to use inline function.
	* trans.h (gfor_fndecl_size0, gfor_fndecl_size1): Remove var decl.

libgfortran/ChangeLog:

	* intrinsics/size.c (size0, size1): Comment that now not
	used by newer compiler code.

libgomp/ChangeLog:

	* testsuite/libgomp.oacc-fortran/privatized-ref-2.f90: Update
	expected dg-note output.

gcc/testsuite/ChangeLog:

	* gfortran.dg/c-interop/cf-out-descriptor-6.f90: Remove xfail.
	* gfortran.dg/c-interop/size.f90: Remove xfail.
	* gfortran.dg/intrinsic_size_3.f90: Update scan-tree-dump-times.
	* gfortran.dg/transpose_optimization_2.f90: Likewise.
	* gfortran.dg/size_optional_dim_1.f90: Add scan-tree-dump-not.
	* gfortran.dg/assumed_rank_22.f90: New test.
	* gfortran.dg/assumed_rank_22_aux.c: New test.

13 files changed, 472 insertions, 122 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0d013de..b8061f3 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7901,31 +7901,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 +8147,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 +8159,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 +8234,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 +8244,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 +8261,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
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index e4d443d..85ff216 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -39,6 +39,8 @@ void gfc_trans_dummy_array_bias (gfc_symbol *, tree, gfc_wrapped_block *);
 /* Generate entry and exit code for g77 calling convention arrays.  */
 void gfc_trans_g77_array (gfc_symbol *, gfc_wrapped_block *);
 
+tree gfc_tree_array_size (stmtblock_t *, tree, gfc_expr *, tree);
+
 tree gfc_full_array_size (stmtblock_t *, tree, int);
 
 tree gfc_duplicate_allocatable (tree, tree, tree, int, tree);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 3bd8a0f..c758d26 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -214,8 +214,6 @@ tree gfor_fndecl_convert_char4_to_char1;
 
 
 /* Other misc. runtime library functions.  */
-tree gfor_fndecl_size0;
-tree gfor_fndecl_size1;
 tree gfor_fndecl_iargc;
 tree gfor_fndecl_kill;
 tree gfor_fndecl_kill_sub;
@@ -3692,18 +3690,6 @@ gfc_build_intrinsic_function_decls (void)
   }
 
   /* Other functions.  */
-  gfor_fndecl_size0 = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("size0")), ". R ",
-	gfc_array_index_type, 1, pvoid_type_node);
-  DECL_PURE_P (gfor_fndecl_size0) = 1;
-  TREE_NOTHROW (gfor_fndecl_size0) = 1;
-
-  gfor_fndecl_size1 = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("size1")), ". R . ",
-	gfc_array_index_type, 2, pvoid_type_node, gfc_array_index_type);
-  DECL_PURE_P (gfor_fndecl_size1) = 1;
-  TREE_NOTHROW (gfor_fndecl_size1) = 1;
-
   gfor_fndecl_iargc = gfc_build_library_function_decl (
 	get_identifier (PREFIX ("iargc")), gfc_int4_type_node, 0);
   TREE_NOTHROW (gfor_fndecl_iargc) = 1;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 41d5452..1c24556 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6450,6 +6450,29 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		    parmse.force_tmp = 1;
 		}
 
+	      /* Special case for assumed-rank arrays: when passing an
+		 argument to a nonallocatable/nonpointer dummy, the bounds have
+		 to be reset as otherwise a last-dim ubound of -1 is
+		 indistinguishable from an assumed-size array in the callee.  */
+	      if (!sym->attr.is_bind_c && e && fsym && fsym->as
+		  && fsym->as->type == AS_ASSUMED_RANK
+		  && e->rank != -1
+		  && e->expr_type == EXPR_VARIABLE
+		  && ((fsym->ts.type == BT_CLASS
+		       && !CLASS_DATA (fsym)->attr.class_pointer
+		       && !CLASS_DATA (fsym)->attr.allocatable)
+		      || (fsym->ts.type != BT_CLASS
+			  && !fsym->attr.pointer && !fsym->attr.allocatable)))
+		{
+		  /* Change AR_FULL to a (:,:,:) ref to force bounds update. */
+		  gfc_ref *ref;
+		  for (ref = e->ref; ref->next; ref = ref->next)
+		    ;
+		  if (ref->u.ar.type == AR_FULL
+		      && ref->u.ar.as->type != AS_ASSUMED_SIZE)
+		    ref->u.ar.type = AR_SECTION;
+		}
+
 	      if (sym->attr.is_bind_c && e
 		  && (is_CFI_desc (fsym, NULL) || assumed_length_string))
 		/* Implement F2018, 18.3.6, list item (5), bullet point 2.  */
@@ -6510,16 +6533,26 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym,
 					  sym->name, NULL);
 
-	      /* Unallocated allocatable arrays and unassociated pointer arrays
-		 need their dtype setting if they are argument associated with
-		 assumed rank dummies, unless already assumed rank.  */
+	      /* Special case for assumed-rank arrays. */
 	      if (!sym->attr.is_bind_c && e && fsym && fsym->as
 		  && fsym->as->type == AS_ASSUMED_RANK
 		  && e->rank != -1)
 		{
-		  if (gfc_expr_attr (e).pointer
+		  if ((gfc_expr_attr (e).pointer
 		      || gfc_expr_attr (e).allocatable)
-		    set_dtype_for_unallocated (&parmse, e);
+		      && ((fsym->ts.type == BT_CLASS
+			   && (CLASS_DATA (fsym)->attr.class_pointer
+			       || CLASS_DATA (fsym)->attr.allocatable))
+			  || (fsym->ts.type != BT_CLASS
+			      && (fsym->attr.pointer || fsym->attr.allocatable))))
+		    {
+		      /* Unallocated allocatable arrays and unassociated pointer
+			 arrays need their dtype setting if they are argument
+			 associated with assumed rank dummies. However, if the
+			 dummy is nonallocate/nonpointer, the user may not
+			 pass those. Hence, it can be skipped.  */
+		      set_dtype_for_unallocated (&parmse, e);
+		    }
 		  else if (e->expr_type == EXPR_VARIABLE
 			   && e->ref
 			   && e->ref->u.ar.type == AR_FULL
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 60e94f0..900a1a2 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -6697,6 +6697,8 @@ gfc_conv_intrinsic_shape (gfc_se *se, gfc_expr *expr)
   gfc_expr *e;
   gfc_array_spec *as;
   gfc_ss *ss;
+  symbol_attribute attr;
+  tree result_desc = se->expr;
 
   /* Remove the KIND argument, if present. */
   s = expr->value.function.actual;
@@ -6707,17 +6709,25 @@ gfc_conv_intrinsic_shape (gfc_se *se, gfc_expr *expr)
 
   gfc_conv_intrinsic_funcall (se, expr);
 
-  as = gfc_get_full_arrayspec_from_expr (s->expr);;
-  ss = gfc_walk_expr (s->expr);
-
   /* According to F2018 16.9.172, para 5, an assumed rank entity, argument
      associated with an assumed size array, has the ubound of the final
      dimension set to -1 and SHAPE must return this.  */
-  if (as && as->type == AS_ASSUMED_RANK
-      && se->expr && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr))
-      && ss && ss->info->type == GFC_SS_SECTION)
+
+  as = gfc_get_full_arrayspec_from_expr (s->expr);
+  if (!as || as->type != AS_ASSUMED_RANK)
+    return;
+  attr = gfc_expr_attr (s->expr);
+  ss = gfc_walk_expr (s->expr);
+  if (attr.pointer || attr.allocatable
+      || !ss || ss->info->type != GFC_SS_SECTION)
+    return;
+  if (se->expr)
+    result_desc = se->expr;
+  if (POINTER_TYPE_P (TREE_TYPE (result_desc)))
+    result_desc = build_fold_indirect_ref_loc (input_location, result_desc);
+  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (result_desc)))
     {
-      tree desc, rank, minus_one, cond, ubound, tmp;
+      tree rank, minus_one, cond, ubound, tmp;
       stmtblock_t block;
       gfc_se ase;
 
@@ -6745,8 +6755,7 @@ gfc_conv_intrinsic_shape (gfc_se *se, gfc_expr *expr)
 
       /* Obtain the last element of the result from the library shape
 	 intrinsic and set it to -1 if that is the value of ubound.  */
-      desc = se->expr;
-      tmp = gfc_conv_array_data (desc);
+      tmp = gfc_conv_array_data (result_desc);
       tmp = build_fold_indirect_ref_loc (input_location, tmp);
       tmp = gfc_build_array_ref (tmp, rank, NULL, NULL);
 
@@ -6758,7 +6767,6 @@ gfc_conv_intrinsic_shape (gfc_se *se, gfc_expr *expr)
 		       build_empty_stmt (input_location));
       gfc_add_expr_to_block (&se->pre, cond);
     }
-
 }
 
 static void
@@ -7968,8 +7976,7 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
   gfc_actual_arglist *actual;
   tree arg1;
   tree type;
-  tree fncall0;
-  tree fncall1;
+  tree size;
   gfc_se argse;
   gfc_expr *e;
   gfc_symbol *sym = NULL;
@@ -8046,37 +8053,31 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
       /* For functions that return a class array conv_expr_descriptor is not
 	 able to get the descriptor right.  Therefore this special case.  */
       gfc_conv_expr_reference (&argse, e);
-      argse.expr = gfc_build_addr_expr (NULL_TREE,
-					gfc_class_data_get (argse.expr));
+      argse.expr = gfc_class_data_get (argse.expr);
     }
   else if (sym && sym->backend_decl)
     {
       gcc_assert (GFC_CLASS_TYPE_P (TREE_TYPE (sym->backend_decl)));
-      argse.expr = sym->backend_decl;
-      argse.expr = gfc_build_addr_expr (NULL_TREE,
-					gfc_class_data_get (argse.expr));
+      argse.expr = gfc_class_data_get (sym->backend_decl);
     }
   else
-    {
-      argse.want_pointer = 1;
-      gfc_conv_expr_descriptor (&argse, actual->expr);
-    }
+    gfc_conv_expr_descriptor (&argse, actual->expr);
   gfc_add_block_to_block (&se->pre, &argse.pre);
   gfc_add_block_to_block (&se->post, &argse.post);
-  arg1 = gfc_evaluate_now (argse.expr, &se->pre);
-
-  /* Build the call to size0.  */
-  fncall0 = build_call_expr_loc (input_location,
-			     gfor_fndecl_size0, 1, arg1);
+  arg1 = argse.expr;
 
   actual = actual->next;
-
   if (actual->expr)
     {
+      stmtblock_t block;
+      gfc_init_block (&block);
       gfc_init_se (&argse, NULL);
       gfc_conv_expr_type (&argse, actual->expr,
 			  gfc_array_index_type);
-      gfc_add_block_to_block (&se->pre, &argse.pre);
+      gfc_add_block_to_block (&block, &argse.pre);
+      tree tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     argse.expr, gfc_index_one_node);
+      size = gfc_tree_array_size (&block, arg1, e, tmp);
 
       /* Unusually, for an intrinsic, size does not exclude
 	 an optional arg2, so we must test for it.  */
@@ -8084,59 +8085,35 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
 	    && actual->expr->symtree->n.sym->attr.dummy
 	    && actual->expr->symtree->n.sym->attr.optional)
 	{
-	  tree tmp;
-	  /* Build the call to size1.  */
-	  fncall1 = build_call_expr_loc (input_location,
-				     gfor_fndecl_size1, 2,
-				     arg1, argse.expr);
-
+	  tree cond;
+	  stmtblock_t block2;
+	  gfc_init_block (&block2);
 	  gfc_init_se (&argse, NULL);
 	  argse.want_pointer = 1;
 	  argse.data_not_needed = 1;
 	  gfc_conv_expr (&argse, actual->expr);
 	  gfc_add_block_to_block (&se->pre, &argse.pre);
-	  tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
-				 argse.expr, null_pointer_node);
-	  tmp = gfc_evaluate_now (tmp, &se->pre);
-	  se->expr = fold_build3_loc (input_location, COND_EXPR,
-				      pvoid_type_node, tmp, fncall1, fncall0);
+	  cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+				  argse.expr, null_pointer_node);
+	  cond = gfc_evaluate_now (cond, &se->pre);
+	  /* 'block2' contains the arg2 absent case, 'block' the arg2 present
+	      case; size_var can be used in both blocks. */
+	  tree size_var = gfc_tree_array_size (&block2, arg1, e, NULL_TREE);
+	  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+				 TREE_TYPE (size_var), size_var, size);
+	  gfc_add_expr_to_block (&block, tmp);
+	  tmp = build3_v (COND_EXPR, cond, gfc_finish_block (&block),
+			  gfc_finish_block (&block2));
+	  gfc_add_expr_to_block (&se->pre, tmp);
+	  size = size_var;
 	}
       else
-	{
-	  se->expr = NULL_TREE;
-	  argse.expr = fold_build2_loc (input_location, MINUS_EXPR,
-					gfc_array_index_type,
-					argse.expr, gfc_index_one_node);
-	}
-    }
-  else if (expr->value.function.actual->expr->rank == 1)
-    {
-      argse.expr = gfc_index_zero_node;
-      se->expr = NULL_TREE;
+	gfc_add_block_to_block (&se->pre, &block);
     }
   else
-    se->expr = fncall0;
-
-  if (se->expr == NULL_TREE)
-    {
-      tree ubound, lbound;
-
-      arg1 = build_fold_indirect_ref_loc (input_location,
-				      arg1);
-      ubound = gfc_conv_descriptor_ubound_get (arg1, argse.expr);
-      lbound = gfc_conv_descriptor_lbound_get (arg1, argse.expr);
-      se->expr = fold_build2_loc (input_location, MINUS_EXPR,
-				  gfc_array_index_type, ubound, lbound);
-      se->expr = fold_build2_loc (input_location, PLUS_EXPR,
-				  gfc_array_index_type,
-				  se->expr, gfc_index_one_node);
-      se->expr = fold_build2_loc (input_location, MAX_EXPR,
-				  gfc_array_index_type, se->expr,
-				  gfc_index_zero_node);
-    }
-
+    size = gfc_tree_array_size (&se->pre, arg1, e, NULL_TREE);
   type = gfc_typenode_for_spec (&expr->ts);
-  se->expr = convert (type, se->expr);
+  se->expr = convert (type, size);
 }
 
 
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 4d29834..53f0f86 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -960,8 +960,6 @@ extern GTY(()) tree gfor_fndecl_convert_char1_to_char4;
 extern GTY(()) tree gfor_fndecl_convert_char4_to_char1;
 
 /* Other misc. runtime library functions.  */
-extern GTY(()) tree gfor_fndecl_size0;
-extern GTY(()) tree gfor_fndecl_size1;
 extern GTY(()) tree gfor_fndecl_iargc;
 extern GTY(()) tree gfor_fndecl_kill;
 extern GTY(()) tree gfor_fndecl_kill_sub;
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_22.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_22.f90
new file mode 100644
index 0000000..8be0c10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_22.f90
@@ -0,0 +1,169 @@
+! { dg-do run }
+! { dg-additional-sources assumed_rank_22_aux.c }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! FIXME: wrong extend in array descriptor, see C file.
+! { dg-output "c_assumed - 40 - OK" { xfail *-*-* } }
+! { dg-output "c_assumed - 100 - OK" { xfail *-*-* } }
+!
+! PR fortran/94070
+!
+! Contributed by Tobias Burnus
+! and José Rui Faustino de Sousa
+!
+program main
+  implicit none
+  integer :: A(5,4,2)
+  integer, allocatable :: B(:,:,:)
+  integer :: C(5,4,-2:-1)
+
+  interface
+    subroutine c_assumed (x, num) bind(C)
+      integer :: x(..)
+      integer, value :: num
+    end subroutine
+    subroutine c_allocated (x) bind(C)
+      integer, allocatable :: x(..)
+    end subroutine
+  end interface
+
+  allocate (B(-1:3,4,-1:-1))
+
+  call caller (a)          ! num=0: assumed-size
+  call test (b, num=20)           ! full array
+  call test (b(:,:,0:-1), num=40) ! zero-sized array
+  call test (c, num=60)
+  call test (c(:,:,:-1), num=80) ! full-size slice
+  call test (c(:,:,1:-1), num=100) !zero-size array
+
+  call test_alloc(b)
+
+  call c_assumed (b, num=20)
+  call c_assumed (b(:,:,0:-1), num=40)
+  call c_assumed (c, num=60)
+  call c_assumed (c(:,:,:-1), num=80)
+  call c_assumed (c(:,:,1:-1), num=100)
+
+  call c_allocated (b)
+contains
+  subroutine caller(y)
+    integer :: y(-1:3,4,*)
+    call test(y, num=0)
+    call c_assumed (y, num=0)
+  end
+  subroutine test (x, num)
+    integer :: x(..), num
+
+    ! SIZE (x)
+    if (num == 0) then
+      if (size (x) /= -20) stop 1
+    elseif (num == 20) then
+      if (size (x) /= 20) stop 21
+    elseif (num == 40) then
+      if (size (x) /= 0) stop 41
+    elseif (num == 60) then
+      if (size (x) /= 40) stop 61
+    elseif (num == 80) then
+      if (size (x) /= 40) stop 81
+    elseif (num == 100) then
+      if (size (x) /= 0) stop 101
+    else
+      stop 99  ! Invalid num
+    endif
+
+    ! SIZE (x, dim=...)
+    if (size (x, dim=1) /= 5) stop num + 2
+    if (size (x, dim=2) /= 4) stop num + 3
+
+    if (num == 0) then
+      if (size (x, dim=3) /= -1) stop 4
+    elseif (num == 20) then
+      if (size (x, dim=3) /= 1) stop 24
+    elseif (num == 40) then
+      if (size (x, dim=3) /= 0) stop 44
+    elseif (num == 60) then
+      if (size (x, dim=3) /= 2) stop 64
+    elseif (num == 80) then
+      if (size (x, dim=3) /= 2) stop 84
+    elseif (num == 100) then
+      if (size (x, dim=3) /= 0) stop 104
+    endif
+
+    ! SHAPE (x)
+    if (num == 0) then
+      if (any (shape (x) /= [5, 4, -1])) stop 5
+    elseif (num == 20) then
+      if (any (shape (x) /= [5, 4, 1])) stop 25
+    elseif (num == 40) then
+      if (any (shape (x) /= [5, 4, 0])) stop 45
+    elseif (num == 60) then
+      if (any (shape (x) /= [5, 4, 2])) stop 65
+    elseif (num == 80) then
+      if (any (shape (x) /= [5, 4, 2])) stop 85
+    elseif (num == 100) then
+      if (any (shape (x) /= [5, 4, 0])) stop 105
+    endif
+
+    ! LBOUND (X)
+    if (any (lbound (x) /= [1, 1, 1])) stop num + 6
+
+    ! LBOUND (X, dim=...)
+    if (lbound (x, dim=1) /= 1) stop num + 7
+    if (lbound (x, dim=2) /= 1) stop num + 8
+    if (lbound (x, dim=3) /= 1) stop num + 9
+
+    ! UBOUND (X)
+    if (num == 0) then
+      if (any (ubound (x) /= [5, 4, -1])) stop 11
+    elseif (num == 20) then
+      if (any (ubound (x) /= [5, 4, 1])) stop 31
+    elseif (num == 40) then
+      if (any (ubound (x) /= [5, 4, 0])) stop 51
+    elseif (num == 60) then
+      if (any (ubound (x) /= [5, 4, 2])) stop 71
+    elseif (num == 80) then
+      if (any (ubound (x) /= [5, 4, 2])) stop 91
+    elseif (num == 100) then
+      if (any (ubound (x) /= [5, 4, 0])) stop 111
+    endif
+
+    ! UBOUND (X, dim=...)
+    if (ubound (x, dim=1) /= 5) stop num + 12
+    if (ubound (x, dim=2) /= 4) stop num + 13
+    if (num == 0) then
+      if (ubound (x, dim=3) /= -1) stop 14
+    elseif (num == 20) then
+      if (ubound (x, dim=3) /= 1) stop 34
+    elseif (num == 40) then
+      if (ubound (x, dim=3) /= 0) stop 54
+    elseif (num == 60) then
+      if (ubound (x, dim=3) /= 2) stop 74
+    elseif (num == 80) then
+      if (ubound (x, dim=3) /= 2) stop 94
+    elseif (num == 100) then
+      if (ubound (x, dim=3) /= 0) stop 114
+    endif
+  end
+
+  subroutine test_alloc (x)
+    integer, allocatable :: x(..)
+
+    if (size (x) /= 20) stop 61
+    if (size (x, dim=1) /= 5) stop 62
+    if (size (x, dim=2) /= 4) stop 63
+    if (size (x, dim=3) /= 1) stop 64
+
+    if (any (shape (x) /= [5, 4, 1])) stop 65
+
+    if (any (lbound (x) /= [-1, 1, -1])) stop 66
+    if (lbound (x, dim=1) /= -1) stop 77
+    if (lbound (x, dim=2) /= 1) stop 78
+    if (lbound (x, dim=3) /= -1) stop 79
+
+    if (any (ubound (x) /= [3, 4, -1])) stop 80
+    if (ubound (x, dim=1) /= 3) stop 92
+    if (ubound (x, dim=2) /= 4) stop 93
+    if (ubound (x, dim=3) /= -1) stop 94
+  end
+end
+! { dg-final { scan-tree-dump-not "_gfortran_size" "original" } } 
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_22_aux.c b/gcc/testsuite/gfortran.dg/assumed_rank_22_aux.c
new file mode 100644
index 0000000..2fbf83d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_22_aux.c
@@ -0,0 +1,68 @@
+/* Called by assumed_rank_22.f90.  */
+
+#include <ISO_Fortran_binding.h>
+#include <assert.h>
+
+void
+c_assumed (CFI_cdesc_t *x, int num)
+{
+  assert (num == 0 || num == 20 || num == 40 || num == 60 || num == 80
+	  || num == 100);
+  assert (x->elem_len == sizeof (int));
+  assert (x->rank == 3);
+  assert (x->type == CFI_type_int32_t);
+
+  assert (x->attribute == CFI_attribute_other);
+  assert (x->dim[0].lower_bound == 0);
+  assert (x->dim[1].lower_bound == 0);
+  assert (x->dim[2].lower_bound == 0);
+  assert (x->dim[0].extent == 5);
+  assert (x->dim[1].extent == 4);
+  if (num == 0)
+    assert (x->dim[2].extent == -1);
+  else if (num == 20)
+    assert (x->dim[2].extent == 1);
+  else if (num == 40)
+    {
+      /* FIXME: - dg-output = 'c_assumed ... OK' checked in .f90 file. */
+      /* assert (x->dim[2].extent == 0); */
+      if (x->dim[2].extent == 0)
+	__builtin_printf ("c_assumed - 40 - OK\n");
+      else
+	__builtin_printf ("ERROR: c_assumed num=%d: "
+		      "x->dim[2].extent = %d != 0\n",
+		      num, x->dim[2].extent);
+    }
+  else if (num == 60)
+    assert (x->dim[2].extent == 2);
+  else if (num == 80)
+    assert (x->dim[2].extent == 2);
+  else if (num == 100)
+    {
+      /* FIXME: - dg-output = 'c_assumed ... OK' checked in .f90 file. */
+      /* assert (x->dim[2].extent == 0); */
+      if (x->dim[2].extent == 0)
+	__builtin_printf ("c_assumed - 100 - OK\n");
+      else
+	__builtin_printf ("ERROR: c_assumed num=%d: "
+		      "x->dim[2].extent = %d != 0\n",
+		      num, x->dim[2].extent);
+    }
+  else
+    assert (0);
+}
+
+void
+c_allocated (CFI_cdesc_t *x)
+{
+  assert (x->elem_len == sizeof (int));
+  assert (x->rank == 3);
+  assert (x->type == CFI_type_int32_t);
+  assert (x->attribute == CFI_attribute_allocatable);
+  assert (x->dim[0].lower_bound == -1);
+  assert (x->dim[1].lower_bound == 1);
+  assert (x->dim[2].lower_bound == -1);
+  assert (x->dim[0].extent == 5);
+  assert (x->dim[1].extent == 4);
+  assert (x->dim[2].extent == 1);
+}
diff --git a/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-6.f90 b/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-6.f90
index b1a8c53..bc19a71 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-6.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/cf-out-descriptor-6.f90
@@ -1,5 +1,5 @@
 ! Reported as pr94070.
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 ! { dg-additional-sources "cf-out-descriptor-6-c.c dump-descriptors.c" }
 ! { dg-additional-options "-g" }
 !
diff --git a/gcc/testsuite/gfortran.dg/c-interop/size.f90 b/gcc/testsuite/gfortran.dg/c-interop/size.f90
index 6c66997..58b32b0 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/size.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/size.f90
@@ -1,5 +1,5 @@
 ! Reported as pr94070.
-! { dg-do run { xfail *-*-* } }
+! { dg-do run }
 !
 ! TS 29113
 ! 6.4.2 SIZE
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90
index 923cbc3..afdf9b3 100644
--- a/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90
+++ b/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90
@@ -22,4 +22,4 @@ program bug
   stop
 end program bug
 
-! { dg-final { scan-tree-dump-times "iszs = \\(integer\\(kind=2\\)\\) MAX_EXPR <\\(D.\[0-9\]+->dim.0..ubound - D.\[0-9\]+->dim.0..lbound\\) \\+ 1, 0>;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "iszs = \\(integer\\(kind=2\\)\\) MAX_EXPR <\\(a.dim.0..ubound - a.dim.0..lbound\\) \\+ 1, 0>;" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/size_optional_dim_1.f90 b/gcc/testsuite/gfortran.dg/size_optional_dim_1.f90
index c6e8f76..cbf4aa4 100644
--- a/gcc/testsuite/gfortran.dg/size_optional_dim_1.f90
+++ b/gcc/testsuite/gfortran.dg/size_optional_dim_1.f90
@@ -1,4 +1,5 @@
 ! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
 ! PR 30865 - passing a subroutine optional argument to size(dim=...)
 ! used to segfault.
 program main
@@ -19,3 +20,6 @@ contains
     ires = size (a1, dim=opt1)
   end subroutine checkv
 end program main
+
+! Ensure inline code is generated, cf. PR fortran/94070
+! { dg-final { scan-tree-dump-not "_gfortran_size" "original" } } 
diff --git a/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90 b/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90
index c49cd42..54271b1 100644
--- a/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90
+++ b/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90
@@ -60,5 +60,5 @@ end
 !
 ! The check below for temporaries gave 14 and 33 for "parm" and "atmp".
 !
-! { dg-final { scan-tree-dump-times "parm" 72 "original" } }
+! { dg-final { scan-tree-dump-times "parm" 76 "original" } }
 ! { dg-final { scan-tree-dump-times "atmp" 13 "original" } }