re PR fortran/88821 (Inline packing of non-contiguous arguments)

2019-05-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/88821
	* expr.c (gfc_is_simply_contiguous): Return true for
	an EXPR_ARRAY.
	* trans-array.c (is_pointer): New function.
	(gfc_conv_array_parameter): Call gfc_conv_subref_array_arg
	when not optimizing and not optimizing for size if the formal
	arg is passed by reference.
	* trans-expr.c (gfc_conv_subref_array_arg): Add arguments
	fsym, proc_name and sym.  Add run-time warning for temporary
	array creation.  Wrap argument if passing on an optional
	argument to an optional argument.
	* trans.h (gfc_conv_subref_array_arg): Add optional arguments
	fsym, proc_name and sym to prototype.

2019-05-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/88821
	* gfortran.dg/alloc_comp_auto_array_3.f90: Add -O0 to dg-options
	to make sure the test for internal_pack is retained.
	* gfortran.dg/assumed_type_2.f90: Split compile and run time
	tests into this and
	* gfortran.dg/assumed_type_2a.f90: New file.
	* gfortran.dg/c_loc_test_22.f90: Likewise.
	* gfortran.dg/contiguous_3.f90: Likewise.
	* gfortran.dg/internal_pack_11.f90: Likewise.
	* gfortran.dg/internal_pack_12.f90: Likewise.
	* gfortran.dg/internal_pack_16.f90: Likewise.
	* gfortran.dg/internal_pack_17.f90: Likewise.
	* gfortran.dg/internal_pack_18.f90: Likewise.
	* gfortran.dg/internal_pack_4.f90: Likewise.
	* gfortran.dg/internal_pack_5.f90: Add -O0 to dg-options
	to make sure the test for internal_pack is retained.
	* gfortran.dg/internal_pack_6.f90: Split compile and run time
	tests into this and
	* gfortran.dg/internal_pack_6a.f90: New file.
	* gfortran.dg/internal_pack_8.f90: Likewise.
	* gfortran.dg/missing_optional_dummy_6: Split compile and run time
	tests into this and
	* gfortran.dg/missing_optional_dummy_6a.f90: New file.
	* gfortran.dg/no_arg_check_2.f90: Split compile and run time tests
	into this and
	* gfortran.dg/no_arg_check_2a.f90: New file.
	* gfortran.dg/typebound_assignment_5.f90: Split compile and run time
	tests into this and
	* gfortran.dg/typebound_assignment_5a.f90: New file.
	* gfortran.dg/typebound_assignment_6.f90: Split compile and run time
	tests into this and
	* gfortran.dg/typebound_assignment_6a.f90: New file.
	* gfortran.dg/internal_pack_19.f90: New file.
	* gfortran.dg/internal_pack_20.f90: New file.
	* gfortran.dg/internal_pack_21.f90: New file.

From-SVN: r271377

1 files changed, 81 insertions, 2 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 3711c38..b7a8456 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4576,8 +4576,10 @@ gfc_apply_interface_mapping (gfc_interface_mapping * mapping,
    an actual argument derived type array is copied and then returned
    after the function call.  */
 void
-gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
-			   sym_intent intent, bool formal_ptr)
+gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77,
+			   sym_intent intent, bool formal_ptr,
+			   const gfc_symbol *fsym, const char *proc_name,
+			   gfc_symbol *sym)
 {
   gfc_se lse;
   gfc_se rse;
@@ -4594,6 +4596,36 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
   stmtblock_t body;
   int n;
   int dimen;
+  gfc_se work_se;
+  gfc_se *parmse;
+  bool pass_optional;
+
+  pass_optional = fsym && fsym->attr.optional && sym && sym->attr.optional;
+
+  if (pass_optional)
+    {
+      gfc_init_se (&work_se, NULL);
+      parmse = &work_se;
+    }
+  else
+    parmse = se;
+
+  if (gfc_option.rtcheck & GFC_RTCHECK_ARRAY_TEMPS)
+    {
+      /* We will create a temporary array, so let us warn.  */
+      char * msg;
+
+      if (fsym && proc_name)
+	msg = xasprintf ("An array temporary was created for argument "
+			     "'%s' of procedure '%s'", fsym->name, proc_name);
+      else
+	msg = xasprintf ("An array temporary was created");
+
+      tmp = build_int_cst (logical_type_node, 1);
+      gfc_trans_runtime_check (false, true, tmp, &parmse->pre,
+			       &expr->where, msg);
+      free (msg);
+    }
 
   gfc_init_se (&lse, NULL);
   gfc_init_se (&rse, NULL);
@@ -4848,6 +4880,53 @@ class_array_fcn:
   else
     parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr);
 
+  if (pass_optional)
+    {
+      tree present;
+      tree type;
+      stmtblock_t else_block;
+      tree pre_stmts, post_stmts;
+      tree pointer;
+      tree else_stmt;
+
+      /* Make this into
+
+	 if (present (a))
+	   {
+	      parmse->pre;
+	      optional = parse->expr;
+	   }
+         else
+	   optional = NULL;
+         call foo (optional);
+         if (present (a))
+            parmse->post;
+
+      */
+
+      type = TREE_TYPE (parmse->expr);
+      pointer = gfc_create_var (type, "optional");
+      tmp = gfc_conv_expr_present (sym);
+      present = gfc_evaluate_now (tmp, &se->pre);
+      gfc_add_modify (&parmse->pre, pointer, parmse->expr);
+      pre_stmts = gfc_finish_block (&parmse->pre);
+
+      gfc_init_block (&else_block);
+      gfc_add_modify (&else_block, pointer, build_int_cst (type, 0));
+      else_stmt = gfc_finish_block (&else_block);
+
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, present,
+			     pre_stmts, else_stmt);
+      gfc_add_expr_to_block (&se->pre, tmp);
+
+      post_stmts = gfc_finish_block (&parmse->post);
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, present,
+			     post_stmts, build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&se->post, tmp);
+
+      se->expr = pointer;
+    }
+
   return;
 }