Hi,

for the record, the attached version of the patch regtests cleanly and
also passes the test that Dominique pointed out.

I will defer this until stage 1 reopens.

Regards

        Thomas
Index: fortran/expr.c
===================================================================
--- fortran/expr.c	(Revision 268104)
+++ fortran/expr.c	(Arbeitskopie)
@@ -5582,6 +5582,9 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool str
   gfc_ref *ref, *part_ref = NULL;
   gfc_symbol *sym;
 
+  if (expr->expr_type == EXPR_ARRAY)
+    return true;
+
   if (expr->expr_type == EXPR_FUNCTION)
     {
       if (expr->value.function.esym)
Index: fortran/trans-array.c
===================================================================
--- fortran/trans-array.c	(Revision 268104)
+++ fortran/trans-array.c	(Arbeitskopie)
@@ -7755,6 +7755,23 @@ array_parameter_size (tree desc, gfc_expr *expr, t
 			   *size, fold_convert (gfc_array_index_type, elem));
 }
 
+/* Helper function - return true if the argument is a pointer.  */
+ 
+static bool
+is_pointer (gfc_expr *e)
+{
+  gfc_symbol *sym;
+
+  if (e->expr_type != EXPR_VARIABLE ||  e->symtree == NULL)
+    return false;
+
+  sym = e->symtree->n.sym;
+  if (sym == NULL)
+    return false;
+
+  return sym->attr.pointer || sym->attr.proc_pointer;
+}
+
 /* Convert an array for passing as an actual parameter.  */
 
 void
@@ -8006,6 +8023,19 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr *
 			 "Creating array temporary at %L", &expr->where);
 	}
 
+      /* When optmizing, we can use gfc_conv_subref_array_arg for
+	 making the packing and unpacking operation visible to the
+	 optimizers.  */
+
+      if (g77 && optimize && !optimize_size && expr->expr_type == EXPR_VARIABLE
+	  && !is_pointer (expr))
+	{
+	  gfc_conv_subref_array_arg (se, expr, g77,
+				     fsym ? fsym->attr.intent : INTENT_INOUT,
+				     false, fsym, proc_name, sym);
+	  return;
+	}
+
       ptr = build_call_expr_loc (input_location,
 			     gfor_fndecl_in_pack, 1, desc);
 
Index: fortran/trans-expr.c
===================================================================
--- fortran/trans-expr.c	(Revision 268104)
+++ fortran/trans-expr.c	(Arbeitskopie)
@@ -4535,8 +4535,10 @@ gfc_apply_interface_mapping (gfc_interface_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;
@@ -4553,7 +4555,37 @@ void
   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);
 
@@ -4807,6 +4839,27 @@ class_array_fcn:
   else
     parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr);
 
+  /* Wrap the above in "if (present(x))" if needed.  */
+
+  if (pass_optional)
+    {
+      tree present;
+      tree type;
+      tree parmse_expr;
+      stmtblock_t block;
+
+      type = TREE_TYPE (parmse->expr);
+      gfc_start_block (&block);
+      gfc_add_block_to_block (&block, &parmse->pre);
+      gfc_add_block_to_block (&block, &parmse->post);
+      parmse_expr = gfc_finish_block (&block);
+
+      present = gfc_conv_expr_present (sym);
+      tmp = fold_build3_loc (input_location, COND_EXPR, type, present,
+			     parmse_expr, build_int_cst (type, 0));
+      se->expr = tmp;
+    }
+
   return;
 }
 
Index: fortran/trans.h
===================================================================
--- fortran/trans.h	(Revision 268104)
+++ fortran/trans.h	(Arbeitskopie)
@@ -529,7 +529,10 @@ int gfc_is_intrinsic_libcall (gfc_expr *);
 int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *,
 			     gfc_expr *, vec<tree, va_gc> *);
 
-void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool);
+void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool,
+				const gfc_symbol *fsym = NULL,
+				const char *proc_name = NULL,
+				gfc_symbol *sym = NULL);
 
 /* Generate code for a scalar assignment.  */
 tree gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool,
Index: testsuite/gfortran.dg/alloc_comp_auto_array_3.f90
===================================================================
--- testsuite/gfortran.dg/alloc_comp_auto_array_3.f90	(Revision 268104)
+++ testsuite/gfortran.dg/alloc_comp_auto_array_3.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-fdump-tree-original" }
+! { dg-options "-O0 -fdump-tree-original" }
 !
 ! Test the fix for PR66082. The original problem was with the first
 ! call foo_1d.
Index: testsuite/gfortran.dg/assumed_type_2.f90
===================================================================
--- testsuite/gfortran.dg/assumed_type_2.f90	(Revision 268104)
+++ testsuite/gfortran.dg/assumed_type_2.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
-! { dg-do run }
-! { dg-options "-fdump-tree-original" }
+! { dg-do compile }
+! { dg-options "-O0 -fdump-tree-original" }
 !
 ! PR fortran/48820
 !
Index: testsuite/gfortran.dg/c_loc_test_22.f90
===================================================================
--- testsuite/gfortran.dg/c_loc_test_22.f90	(Revision 268104)
+++ testsuite/gfortran.dg/c_loc_test_22.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-fdump-tree-original" }
+! { dg-options "-O0 -fdump-tree-original" }
 !
 ! PR fortran/56907
 !
Index: testsuite/gfortran.dg/contiguous_3.f90
===================================================================
--- testsuite/gfortran.dg/contiguous_3.f90	(Revision 268104)
+++ testsuite/gfortran.dg/contiguous_3.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-fdump-tree-original" }
+! { dg-options "-O0 -fdump-tree-original" }
 !
 ! PR fortran/40632
 !
Index: testsuite/gfortran.dg/internal_pack_11.f90
===================================================================
--- testsuite/gfortran.dg/internal_pack_11.f90	(Revision 268104)
+++ testsuite/gfortran.dg/internal_pack_11.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-fdump-tree-original" }
+! { dg-options "-O0 -fdump-tree-original" }
 !
 ! Test the fix for PR43173, where unnecessary calls to internal_pack/unpack
 ! were being produced below. These references are contiguous and so do not
Index: testsuite/gfortran.dg/internal_pack_12.f90
===================================================================
--- testsuite/gfortran.dg/internal_pack_12.f90	(Revision 268104)
+++ testsuite/gfortran.dg/internal_pack_12.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-fdump-tree-original" }
+! { dg-options "-O0 -fdump-tree-original" }
 !
 ! Test the fix for PR43243, where unnecessary calls to internal_pack/unpack
 ! were being produced below. These references are contiguous and so do not
Index: testsuite/gfortran.dg/internal_pack_16.f90
===================================================================
--- testsuite/gfortran.dg/internal_pack_16.f90	(Revision 268104)
+++ testsuite/gfortran.dg/internal_pack_16.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-additional-options "-fdump-tree-original" }
+! { dg-additional-options "-O0 -fdump-tree-original" }
 ! PR 59345 - pack/unpack was not needed here.
 SUBROUTINE S1(A)
  REAL :: A(3)
Index: testsuite/gfortran.dg/internal_pack_17.f90
===================================================================
--- testsuite/gfortran.dg/internal_pack_17.f90	(Revision 268104)
+++ testsuite/gfortran.dg/internal_pack_17.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-additional-options "-fdump-tree-original" }
+! { dg-additional-options "-O0 -fdump-tree-original" }
 ! PR 59345 - pack/unpack was not needed here.
 ! Original test case by Joost VandeVondele 
 SUBROUTINE S1(A)
Index: testsuite/gfortran.dg/internal_pack_18.f90
===================================================================
--- testsuite/gfortran.dg/internal_pack_18.f90	(Revision 268104)
+++ testsuite/gfortran.dg/internal_pack_18.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-additional-options "-fdump-tree-original" }
+! { dg-additional-options "-O0 -fdump-tree-original" }
 ! PR 57992 - this was packed/unpacked unnecessarily.
 ! Original case by Tobias Burnus.
 subroutine test
Index: testsuite/gfortran.dg/internal_pack_4.f90
===================================================================
--- testsuite/gfortran.dg/internal_pack_4.f90	(Revision 268104)
+++ testsuite/gfortran.dg/internal_pack_4.f90	(Arbeitskopie)
@@ -1,5 +1,4 @@
 ! { dg-do run }
-! { dg-options "-fdump-tree-original" }
 !
 ! PR fortran/36132
 !
@@ -25,6 +24,3 @@ END MODULE M1
 USE M1
 CALL S2()
 END
-
-! { dg-final { scan-tree-dump-times "a != 0B \\? \\\(.*\\\) _gfortran_internal_pack" 1 "original" } }
-! { dg-final { scan-tree-dump-times "if \\(a != 0B &&" 1 "original" } }
Index: testsuite/gfortran.dg/internal_pack_5.f90
===================================================================
--- testsuite/gfortran.dg/internal_pack_5.f90	(Revision 268104)
+++ testsuite/gfortran.dg/internal_pack_5.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-fdump-tree-original" }
+! { dg-options "-O0 -fdump-tree-original" }
 !
 ! PR fortran/36909
 !
Index: testsuite/gfortran.dg/internal_pack_6.f90
===================================================================
--- testsuite/gfortran.dg/internal_pack_6.f90	(Revision 268104)
+++ testsuite/gfortran.dg/internal_pack_6.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
-! { dg-do run }
-! { dg-options "-fdump-tree-original" }
+! { dg-do compile }
+! { dg-options "-O0 -fdump-tree-original" }
 !
 ! Test the fix for PR41113 and PR41117, in which unnecessary calls
 ! to internal_pack and internal_unpack were being generated.
Index: testsuite/gfortran.dg/internal_pack_9.f90
===================================================================
--- testsuite/gfortran.dg/internal_pack_9.f90	(Revision 268104)
+++ testsuite/gfortran.dg/internal_pack_9.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-fdump-tree-original" }
+! { dg-options "-O0 -fdump-tree-original" }
 !
 ! During the discussion of the fix for PR43072, in which unnecessary
 ! calls to internal PACK/UNPACK were being generated, the following,
Index: testsuite/gfortran.dg/missing_optional_dummy_6.f90
===================================================================
--- testsuite/gfortran.dg/missing_optional_dummy_6.f90	(Revision 268104)
+++ testsuite/gfortran.dg/missing_optional_dummy_6.f90	(Arbeitskopie)
@@ -46,14 +46,3 @@ contains
   end subroutine scalar2
 
 end program test
-
-! { dg-final { scan-tree-dump-times "scalar2 \\(slr1" 1 "original" } }
-
-! { dg-final { scan-tree-dump-times "= es1 != 0B" 1 "original" } }
-! { dg-final { scan-tree-dump-times "assumed_shape2 \\(es1" 0 "original" } }
-! { dg-final { scan-tree-dump-times "explicit_shape2 \\(es1" 1 "original" } }
-
-! { dg-final { scan-tree-dump-times "= as1 != 0B" 2 "original" } }
-! { dg-final { scan-tree-dump-times "assumed_shape2 \\(as1" 0 "original" } }
-! { dg-final { scan-tree-dump-times "explicit_shape2 \\(as1" 0 "original" } }
-
Index: testsuite/gfortran.dg/no_arg_check_2.f90
===================================================================
--- testsuite/gfortran.dg/no_arg_check_2.f90	(Revision 268104)
+++ testsuite/gfortran.dg/no_arg_check_2.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
-! { dg-do run }
-! { dg-options "-fdump-tree-original" }
+! { dg-do compile }
+! { dg-options "-O0 -fdump-tree-original" }
 !
 ! PR fortran/39505
 ! 
Index: testsuite/gfortran.dg/typebound_assignment_5.f03
===================================================================
--- testsuite/gfortran.dg/typebound_assignment_5.f03	(Revision 268104)
+++ testsuite/gfortran.dg/typebound_assignment_5.f03	(Arbeitskopie)
@@ -1,5 +1,5 @@
-! { dg-do run }
-! { dg-options "-fdump-tree-original" }
+! { dg-do compile }
+! { dg-options "-O0 -fdump-tree-original" }
 !
 ! PR fortran/49074
 ! ICE on defined assignment with class arrays.
Index: testsuite/gfortran.dg/typebound_assignment_6.f03
===================================================================
--- testsuite/gfortran.dg/typebound_assignment_6.f03	(Revision 268104)
+++ testsuite/gfortran.dg/typebound_assignment_6.f03	(Arbeitskopie)
@@ -1,5 +1,4 @@
 ! { dg-do run }
-! { dg-options "-fdump-tree-original" }
 !
 ! PR fortran/56136
 ! ICE on defined assignment with class arrays.
@@ -37,6 +36,3 @@
         IF (ANY(A(2::2)%I /= (/ ((50+2*I, I=1,SIZE(A)/4), J=1,2) /))) STOP 3
       END PROGRAM
 
-! { dg-final { scan-tree-dump-times "_gfortran_internal_pack" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_internal_unpack" 1 "original" } }
-

Reply via email to