Hi Paul,
Could you provide the patch, please, or was it already posted?
Actually, no. I was so intent on providing the test cases that
I missed the patch itself :-)
Here it is.
Regards
Thomas
Index: fortran/expr.c
===================================================================
--- fortran/expr.c (Revision 270622)
+++ fortran/expr.c (Arbeitskopie)
@@ -5713,6 +5713,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 270622)
+++ fortran/trans-array.c (Arbeitskopie)
@@ -7869,6 +7869,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
@@ -8120,6 +8137,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 270622)
+++ fortran/trans-expr.c (Arbeitskopie)
@@ -4576,8 +4576,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;
@@ -4594,7 +4596,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);
@@ -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;
}
Index: fortran/trans.h
===================================================================
--- fortran/trans.h (Revision 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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 270622)
+++ 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" } }
-
