Successfully identified regression in *gcc* in CI configuration tcwg_bmk_gnu_tk1/gnu-release-arm-spec2k6-O2. So far, this commit has regressed CI configurations: - tcwg_bmk_gnu_tk1/gnu-release-arm-spec2k6-O2

Culprit: <cut> commit bf09e559b22b44e74a91ccc00507a1885ec3d578 Author: Thomas Koenig tkoenig@gcc.gnu.org Date: Sun May 19 10:21:06 2019 +0000

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 </cut>

Results regressed to (for first_bad == bf09e559b22b44e74a91ccc00507a1885ec3d578) # reset_artifacts: -10 # build_abe binutils: -9 # build_abe stage1 -- --set gcc_override_configure=--with-mode=arm --set gcc_override_configure=--disable-libsanitizer: -8 # build_abe linux: -7 # build_abe glibc: -6 # build_abe stage2 -- --set gcc_override_configure=--with-mode=arm --set gcc_override_configure=--disable-libsanitizer: -5 # true: 0 # benchmark -O2_marm -- artifacts/build-bf09e559b22b44e74a91ccc00507a1885ec3d578/results_id: 1 # 481.wrf,wrf_base.default regressed by 107 # 481.wrf,[.] __module_small_step_em_MOD_advance_w regressed by 112

from (for last_good == 14688b8de389740f07079a945edf887a682fc9d1) # reset_artifacts: -10 # build_abe binutils: -9 # build_abe stage1 -- --set gcc_override_configure=--with-mode=arm --set gcc_override_configure=--disable-libsanitizer: -8 # build_abe linux: -7 # build_abe glibc: -6 # build_abe stage2 -- --set gcc_override_configure=--with-mode=arm --set gcc_override_configure=--disable-libsanitizer: -5 # true: 0 # benchmark -O2_marm -- artifacts/build-14688b8de389740f07079a945edf887a682fc9d1/results_id: 1

Artifacts of last_good build: https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-ar... Results ID of last_good: tk1_32/tcwg_bmk_gnu_tk1/bisect-gnu-release-arm-spec2k6-O2/1812 Artifacts of first_bad build: https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-ar... Results ID of first_bad: tk1_32/tcwg_bmk_gnu_tk1/bisect-gnu-release-arm-spec2k6-O2/1816 Build top page/logs: https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-ar...

Configuration details:

Reproduce builds: <cut> mkdir investigate-gcc-bf09e559b22b44e74a91ccc00507a1885ec3d578 cd investigate-gcc-bf09e559b22b44e74a91ccc00507a1885ec3d578

git clone https://git.linaro.org/toolchain/jenkins-scripts

mkdir -p artifacts/manifests curl -o artifacts/manifests/build-baseline.sh https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-ar... --fail curl -o artifacts/manifests/build-parameters.sh https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-ar... --fail curl -o artifacts/test.sh https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-ar... --fail chmod +x artifacts/test.sh

# Reproduce the baseline build (build all pre-requisites) ./jenkins-scripts/tcwg_bmk-build.sh @@ artifacts/manifests/build-baseline.sh

# Save baseline build state (which is then restored in artifacts/test.sh) rsync -a --del --delete-excluded --exclude bisect/ --exclude artifacts/ --exclude gcc/ ./ ./bisect/baseline/

cd gcc

# Reproduce first_bad build git checkout --detach bf09e559b22b44e74a91ccc00507a1885ec3d578 ../artifacts/test.sh

# Reproduce last_good build git checkout --detach 14688b8de389740f07079a945edf887a682fc9d1 ../artifacts/test.sh

cd .. </cut>

History of pending regressions and results: https://git.linaro.org/toolchain/ci/base-artifacts.git/log/?h=linaro-local/c...

Artifacts: https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-ar... Build log: https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-ar...

Full commit (up to 1000 lines): <cut> commit bf09e559b22b44e74a91ccc00507a1885ec3d578 Author: Thomas Koenig tkoenig@gcc.gnu.org Date: Sun May 19 10:21:06 2019 +0000

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 --- gcc/fortran/expr.c | 3 + gcc/fortran/trans-array.c | 31 +++++ gcc/fortran/trans-expr.c | 83 +++++++++++- gcc/fortran/trans.h | 5 +- .../gfortran.dg/alloc_comp_auto_array_3.f90 | 2 +- gcc/testsuite/gfortran.dg/assumed_type_2.f90 | 4 +- gcc/testsuite/gfortran.dg/assumed_type_2a.f90 | 139 +++++++++++++++++++++ gcc/testsuite/gfortran.dg/c_loc_test_22.f90 | 2 +- gcc/testsuite/gfortran.dg/contiguous_3.f90 | 2 +- gcc/testsuite/gfortran.dg/internal_pack_11.f90 | 2 +- gcc/testsuite/gfortran.dg/internal_pack_12.f90 | 2 +- gcc/testsuite/gfortran.dg/internal_pack_16.f90 | 2 +- gcc/testsuite/gfortran.dg/internal_pack_17.f90 | 2 +- gcc/testsuite/gfortran.dg/internal_pack_18.f90 | 2 +- gcc/testsuite/gfortran.dg/internal_pack_19.f90 | 23 ++++ gcc/testsuite/gfortran.dg/internal_pack_20.f90 | 23 ++++ gcc/testsuite/gfortran.dg/internal_pack_21.f90 | 24 ++++ gcc/testsuite/gfortran.dg/internal_pack_4.f90 | 4 - gcc/testsuite/gfortran.dg/internal_pack_5.f90 | 2 +- gcc/testsuite/gfortran.dg/internal_pack_6.f90 | 4 +- gcc/testsuite/gfortran.dg/internal_pack_6a.f90 | 56 +++++++++ gcc/testsuite/gfortran.dg/internal_pack_9.f90 | 2 +- .../gfortran.dg/missing_optional_dummy_6.f90 | 11 -- .../gfortran.dg/missing_optional_dummy_6a.f90 | 59 +++++++++ gcc/testsuite/gfortran.dg/no_arg_check_2.f90 | 4 +- gcc/testsuite/gfortran.dg/no_arg_check_2a.f90 | 121 ++++++++++++++++++ .../gfortran.dg/typebound_assignment_5.f03 | 4 +- .../gfortran.dg/typebound_assignment_5a.f03 | 39 ++++++ .../gfortran.dg/typebound_assignment_6.f03 | 4 - .../gfortran.dg/typebound_assignment_6a.f03 | 42 +++++++ 30 files changed, 663 insertions(+), 40 deletions(-)

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 474e9ecc401..949eff19cdd 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -5713,6 +5713,9 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) 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) diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 8a0de6140ed..9c96d897f41 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7866,6 +7866,23 @@ array_parameter_size (tree desc, gfc_expr *expr, tree *size) *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 @@ -8117,6 +8134,20 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, "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) && (fsym == NULL + || fsym->ts.type != BT_ASSUMED)) + { + 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);

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 3711c38b2f2..b7a8456c021 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; }

diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 273c75a422c..e0118abaf18 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -532,7 +532,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, diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90 index 15f9ecb74de..2af089e84e8 100644 --- a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90 +++ b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90 @@ -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. diff --git a/gcc/testsuite/gfortran.dg/assumed_type_2.f90 b/gcc/testsuite/gfortran.dg/assumed_type_2.f90 index dce5ac6839c..5d3cd7eaece 100644 --- a/gcc/testsuite/gfortran.dg/assumed_type_2.f90 +++ b/gcc/testsuite/gfortran.dg/assumed_type_2.f90 @@ -1,5 +1,5 @@ -! { dg-do run } -! { dg-options "-fdump-tree-original" } +! { dg-do compile } +! { dg-options "-O0 -fdump-tree-original" } ! ! PR fortran/48820 ! diff --git a/gcc/testsuite/gfortran.dg/assumed_type_2a.f90 b/gcc/testsuite/gfortran.dg/assumed_type_2a.f90 new file mode 100644 index 00000000000..125bfcbe839 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assumed_type_2a.f90 @@ -0,0 +1,139 @@ +! { dg-do run } +! +! PR fortran/48820 +! +! Test TYPE(*) +! + +module mod + use iso_c_binding, only: c_loc, c_ptr, c_bool + implicit none + interface my_c_loc + function my_c_loc1(x) bind(C) + import c_ptr + type(*) :: x + type(c_ptr) :: my_c_loc1 + end function + function my_c_loc2(x) bind(C) + import c_ptr + type(*) :: x(*) + type(c_ptr) :: my_c_loc2 + end function + end interface my_c_loc +contains + subroutine sub_scalar (arg1, presnt) + type(*), target, optional :: arg1 + logical :: presnt + type(c_ptr) :: cpt + if (presnt .neqv. present (arg1)) STOP 1 + cpt = c_loc (arg1) + end subroutine sub_scalar + + subroutine sub_array_shape (arg2, lbounds, ubounds) + type(*), target :: arg2(:,:) + type(c_ptr) :: cpt + integer :: lbounds(2), ubounds(2) + if (any (lbound(arg2) /= lbounds)) STOP 2 + if (any (ubound(arg2) /= ubounds)) STOP 3 + if (any (shape(arg2) /= ubounds-lbounds+1)) STOP 4 + if (size(arg2) /= product (ubounds-lbounds+1)) STOP 5 + if (rank (arg2) /= 2) STOP 6 +! if (.not. is_continuous (arg2)) STOP 7 !<< Not yet implemented +! cpt = c_loc (arg2) ! << FIXME: Valid since TS29113 + call sub_array_assumed (arg2) + end subroutine sub_array_shape + + subroutine sub_array_assumed (arg3) + type(*), target :: arg3(*) + type(c_ptr) :: cpt + cpt = c_loc (arg3) + end subroutine sub_array_assumed +end module + +use mod +use iso_c_binding, only: c_int, c_null_ptr +implicit none +type t1 + integer :: a +end type t1 +type :: t2 + sequence + integer :: b +end type t2 +type, bind(C) :: t3 + integer(c_int) :: c +end type t3 + +integer :: scalar_int +real, allocatable :: scalar_real_alloc +character, pointer :: scalar_char_ptr + +integer :: array_int(3) +real, allocatable :: array_real_alloc(:,:) +character, pointer :: array_char_ptr(:,:) + +type(t1) :: scalar_t1 +type(t2), allocatable :: scalar_t2_alloc +type(t3), pointer :: scalar_t3_ptr + +type(t1) :: array_t1(4) +type(t2), allocatable :: array_t2_alloc(:,:) +type(t3), pointer :: array_t3_ptr(:,:) + +class(t1), allocatable :: scalar_class_t1_alloc +class(t1), pointer :: scalar_class_t1_ptr + +class(t1), allocatable :: array_class_t1_alloc(:,:) +class(t1), pointer :: array_class_t1_ptr(:,:) + +scalar_char_ptr => null() +scalar_t3_ptr => null() + +call sub_scalar (presnt=.false.) +call sub_scalar (scalar_real_alloc, .false.) +call sub_scalar (scalar_char_ptr, .false.) +call sub_scalar (null (), .false.) +call sub_scalar (scalar_t2_alloc, .false.) +call sub_scalar (scalar_t3_ptr, .false.) + +allocate (scalar_real_alloc, scalar_char_ptr, scalar_t3_ptr) +allocate (scalar_class_t1_alloc, scalar_class_t1_ptr, scalar_t2_alloc) +allocate (array_real_alloc(3:5,2:4), array_char_ptr(-2:2,2)) +allocate (array_t2_alloc(3:5,2:4), array_t3_ptr(-2:2,2)) +allocate (array_class_t1_alloc(3,3), array_class_t1_ptr(4,4)) + +call sub_scalar (scalar_int, .true.) +call sub_scalar (scalar_real_alloc, .true.) +call sub_scalar (scalar_char_ptr, .true.) +call sub_scalar (array_int(2), .true.) +call sub_scalar (array_real_alloc(3,2), .true.) +call sub_scalar (array_char_ptr(0,1), .true.) +call sub_scalar (scalar_t1, .true.) +call sub_scalar (scalar_t2_alloc, .true.) +call sub_scalar (scalar_t3_ptr, .true.) +call sub_scalar (array_t1(2), .true.) +call sub_scalar (array_t2_alloc(3,2), .true.) +call sub_scalar (array_t3_ptr(0,1), .true.) +call sub_scalar (array_class_t1_alloc(2,1), .true.) +call sub_scalar (array_class_t1_ptr(3,3), .true.) + +call sub_array_assumed (array_int) +call sub_array_assumed (array_real_alloc) +call sub_array_assumed (array_char_ptr) +call sub_array_assumed (array_t1) +call sub_array_assumed (array_t2_alloc) +call sub_array_assumed (array_t3_ptr) +call sub_array_assumed (array_class_t1_alloc) +call sub_array_assumed (array_class_t1_ptr) + +call sub_array_shape (array_real_alloc, [1,1], shape(array_real_alloc)) +call sub_array_shape (array_char_ptr, [1,1], shape(array_char_ptr)) +call sub_array_shape (array_t2_alloc, [1,1], shape(array_t2_alloc)) +call sub_array_shape (array_t3_ptr, [1,1], shape(array_t3_ptr)) +call sub_array_shape (array_class_t1_alloc, [1,1], shape(array_class_t1_alloc)) +call sub_array_shape (array_class_t1_ptr, [1,1], shape(array_class_t1_ptr)) + +deallocate (scalar_char_ptr, scalar_class_t1_ptr, array_char_ptr) +deallocate (array_class_t1_ptr, array_t3_ptr) + +end diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 index 5f4f9775b4a..9c40b26d830 100644 --- a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 +++ b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-options "-fdump-tree-original" } +! { dg-options "-O0 -fdump-tree-original" } ! ! PR fortran/56907 ! diff --git a/gcc/testsuite/gfortran.dg/contiguous_3.f90 b/gcc/testsuite/gfortran.dg/contiguous_3.f90 index 724ec83ed10..ba0ccce8f9e 100644 --- a/gcc/testsuite/gfortran.dg/contiguous_3.f90 +++ b/gcc/testsuite/gfortran.dg/contiguous_3.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-options "-fdump-tree-original" } +! { dg-options "-O0 -fdump-tree-original" } ! ! PR fortran/40632 ! diff --git a/gcc/testsuite/gfortran.dg/internal_pack_11.f90 b/gcc/testsuite/gfortran.dg/internal_pack_11.f90 index a1d357cee73..c341a1bbc5f 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_11.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_11.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/internal_pack_12.f90 b/gcc/testsuite/gfortran.dg/internal_pack_12.f90 index 55631c80e6e..da507322cbb 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_12.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_12.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/internal_pack_16.f90 b/gcc/testsuite/gfortran.dg/internal_pack_16.f90 index 7e34c2bf733..92c4b150db8 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_16.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_16.f90 @@ -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) diff --git a/gcc/testsuite/gfortran.dg/internal_pack_17.f90 b/gcc/testsuite/gfortran.dg/internal_pack_17.f90 index c1b813b0c91..176ad879ba2 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_17.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_17.f90 @@ -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) diff --git a/gcc/testsuite/gfortran.dg/internal_pack_18.f90 b/gcc/testsuite/gfortran.dg/internal_pack_18.f90 index ede0691bb9f..b4404726d12 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_18.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_18.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/internal_pack_19.f90 b/gcc/testsuite/gfortran.dg/internal_pack_19.f90 new file mode 100644 index 00000000000..06b916b7d8e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/internal_pack_19.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-options "-Os -fdump-tree-original" } +! Check that internal_pack is called with -Os. +module x + implicit none +contains + subroutine bar(a, n) + integer, intent(in) :: n + integer, intent(in), dimension(n) :: a + print *,a + end subroutine bar +end module x + +program main + use x + implicit none + integer, parameter :: n = 10 + integer, dimension(n) :: a + integer :: i + a = [(i,i=1,n)] + call bar(a(n:1:-1),n) +end program main +! { dg-final { scan-tree-dump-times "_gfortran_internal_pack" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/internal_pack_20.f90 b/gcc/testsuite/gfortran.dg/internal_pack_20.f90 new file mode 100644 index 00000000000..f93f06bf272 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/internal_pack_20.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-options "-O -fdump-tree-original" } +! Check that internal_pack is not called with -O. +module x + implicit none +contains + subroutine bar(a, n) + integer, intent(in) :: n + integer, intent(in), dimension(n) :: a + print *,a + end subroutine bar +end module x + +program main + use x + implicit none + integer, parameter :: n = 10 + integer, dimension(n) :: a + integer :: i + a = [(i,i=1,n)] + call bar(a(n:1:-1),n) +end program main +! { dg-final { scan-tree-dump-not "_gfortran_internal_pack" "original" } } diff --git a/gcc/testsuite/gfortran.dg/internal_pack_21.f90 b/gcc/testsuite/gfortran.dg/internal_pack_21.f90 new file mode 100644 index 00000000000..d0ce942a9f8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/internal_pack_21.f90 @@ -0,0 +1,24 @@ +! { dg-do run } +! { dg-options "-O -fdump-tree-original" } +! Test handling of the optional argument. + +MODULE M1 + INTEGER, PARAMETER :: dp=KIND(0.0D0) +CONTAINS + SUBROUTINE S1(a) + REAL(dp), DIMENSION(45), INTENT(OUT), & + OPTIONAL :: a + if (present(a)) STOP 1 + END SUBROUTINE S1 + SUBROUTINE S2(a) + REAL(dp), DIMENSION(:, :), INTENT(OUT), & + OPTIONAL :: a + CALL S1(a) + END SUBROUTINE +END MODULE M1 + +USE M1 +CALL S2() +END +! { dg-final { scan-tree-dump-times "optional" 4 "original" } } +! { dg-final { scan-tree-dump-not "_gfortran_internal_unpack" "original" } } diff --git a/gcc/testsuite/gfortran.dg/internal_pack_4.f90 b/gcc/testsuite/gfortran.dg/internal_pack_4.f90 index 00f316414bc..9de09ab072b 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_4.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_4.f90 @@ -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" } } diff --git a/gcc/testsuite/gfortran.dg/internal_pack_5.f90 b/gcc/testsuite/gfortran.dg/internal_pack_5.f90 index 3c5868f9efc..360ade491b5 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_5.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_5.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-options "-fdump-tree-original" } +! { dg-options "-O0 -fdump-tree-original" } ! ! PR fortran/36909 ! diff --git a/gcc/testsuite/gfortran.dg/internal_pack_6.f90 b/gcc/testsuite/gfortran.dg/internal_pack_6.f90 index d6102761904..6d52a8c98c4 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_6.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_6.f90 @@ -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. diff --git a/gcc/testsuite/gfortran.dg/internal_pack_6a.f90 b/gcc/testsuite/gfortran.dg/internal_pack_6a.f90 new file mode 100644 index 00000000000..a9fb2b52d97 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/internal_pack_6a.f90 @@ -0,0 +1,56 @@ +! { dg-do run } +! +! Test the fix for PR41113 and PR41117, in which unnecessary calls +! to internal_pack and internal_unpack were being generated. +! +! Contributed by Joost VandeVondele jv244@cam.ac.uk +! +MODULE M1 + TYPE T1 + REAL :: data(10) = [(i, i = 1, 10)] + END TYPE T1 +CONTAINS + SUBROUTINE S1(data, i, chksum) + REAL, DIMENSION(*) :: data + integer :: i, j + real :: subsum, chksum + subsum = 0 + do j = 1, i + subsum = subsum + data(j) + end do + if (abs(subsum - chksum) > 1e-6) STOP 1 + END SUBROUTINE S1 +END MODULE + +SUBROUTINE S2 + use m1 + TYPE(T1) :: d + + real :: data1(10) = [(i, i = 1, 10)] + REAL :: data(-4:5,-4:5) = reshape ([(real(i), i = 1, 100)], [10,10]) + +! PR41113 + CALL S1(d%data, 10, sum (d%data)) + CALL S1(data1, 10, sum (data1)) + +! PR41117 + DO i=-4,5 + CALL S1(data(:,i), 10, sum (data(:,i))) + ENDDO + +! With the fix for PR41113/7 this is the only time that _internal_pack +! was called. The final part of the fix for PR43072 put paid to it too. + DO i=-4,5 + CALL S1(data(-2:,i), 8, sum (data(-2:,i))) + ENDDO + DO i=-4,4 + CALL S1(data(:,i:i+1), 20, sum (reshape (data(:,i:i+1), [20]))) + ENDDO + DO i=-4,5 + CALL S1(data(2,i), 1, data(2,i)) + ENDDO +END SUBROUTINE S2 + + call s2 +end + diff --git a/gcc/testsuite/gfortran.dg/internal_pack_9.f90 b/gcc/testsuite/gfortran.dg/internal_pack_9.f90 index 9ce53f44354..2b44db5a805 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_9.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_9.f90 @@ -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, diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_6.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6.f90 index 4468ff159b9..cb6de2ebf61 100644 --- a/gcc/testsuite/gfortran.dg/missing_optional_dummy_6.f90 +++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6.f90 @@ -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" } } - diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 new file mode 100644 index 00000000000..0e08ed3aa0c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 @@ -0,0 +1,59 @@ +! { dg-do compile } +! { dg-options "-O0 -fdump-tree-original" } +! +! PR fortran/41907 +! +program test + implicit none + call scalar1 () + call assumed_shape1 () + call explicit_shape1 () +contains + + ! Calling functions + subroutine scalar1 (slr1) + integer, optional :: slr1 + call scalar2 (slr1) + end subroutine scalar1 + + subroutine assumed_shape1 (as1) + integer, dimension(:), optional :: as1 + call assumed_shape2 (as1) + call explicit_shape2 (as1) + end subroutine assumed_shape1 + + subroutine explicit_shape1 (es1) + integer, dimension(5), optional :: es1 + call assumed_shape2 (es1) + call explicit_shape2 (es1) + end subroutine explicit_shape1 + + + ! Called functions + subroutine assumed_shape2 (as2) + integer, dimension(:),optional :: as2 + if (present (as2)) STOP 1 + end subroutine assumed_shape2 + + subroutine explicit_shape2 (es2) + integer, dimension(5),optional :: es2 + if (present (es2)) STOP 2 + end subroutine explicit_shape2 + + subroutine scalar2 (slr2) + integer, optional :: slr2 + if (present (slr2)) STOP 3 + 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" } } + diff --git a/gcc/testsuite/gfortran.dg/no_arg_check_2.f90 b/gcc/testsuite/gfortran.dg/no_arg_check_2.f90 index fe334883a3e..3570b9719eb 100644 --- a/gcc/testsuite/gfortran.dg/no_arg_check_2.f90 +++ b/gcc/testsuite/gfortran.dg/no_arg_check_2.f90 @@ -1,5 +1,5 @@ -! { dg-do run } -! { dg-options "-fdump-tree-original" } +! { dg-do compile } +! { dg-options "-O0 -fdump-tree-original" } ! ! PR fortran/39505 ! diff --git a/gcc/testsuite/gfortran.dg/no_arg_check_2a.f90 b/gcc/testsuite/gfortran.dg/no_arg_check_2a.f90 new file mode 100644 index 00000000000..dc4adcb5619 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/no_arg_check_2a.f90 @@ -0,0 +1,121 @@ +! { dg-do run } +! +! PR fortran/39505 +! +! Test NO_ARG_CHECK +! Copied from assumed_type_2.f90 +! + +module mod + use iso_c_binding, only: c_loc, c_ptr, c_bool + implicit none + interface my_c_loc + function my_c_loc1(x) bind(C) + import c_ptr +!GCC$ attributes NO_ARG_CHECK :: x + type(*) :: x + type(c_ptr) :: my_c_loc1 + end function + end interface my_c_loc +contains + subroutine sub_scalar (arg1, presnt) + integer(8), target, optional :: arg1 + logical :: presnt + type(c_ptr) :: cpt +!GCC$ attributes NO_ARG_CHECK :: arg1 + if (presnt .neqv. present (arg1)) STOP 1 + cpt = c_loc (arg1) + end subroutine sub_scalar + + subroutine sub_array_assumed (arg3) +!GCC$ attributes NO_ARG_CHECK :: arg3 + logical(1), target :: arg3(*) + type(c_ptr) :: cpt + cpt = c_loc (arg3) + end subroutine sub_array_assumed +end module + +use mod +use iso_c_binding, only: c_int, c_null_ptr +implicit none +type t1 + integer :: a +end type t1 +type :: t2 + sequence + integer :: b +end type t2 +type, bind(C) :: t3 + integer(c_int) :: c +end type t3 + +integer :: scalar_int +real, allocatable :: scalar_real_alloc +character, pointer :: scalar_char_ptr + +integer :: array_int(3) +real, allocatable :: array_real_alloc(:,:) +character, pointer :: array_char_ptr(:,:) + +type(t1) :: scalar_t1 +type(t2), allocatable :: scalar_t2_alloc +type(t3), pointer :: scalar_t3_ptr + +type(t1) :: array_t1(4) +type(t2), allocatable :: array_t2_alloc(:,:) +type(t3), pointer :: array_t3_ptr(:,:) + +class(t1), allocatable :: scalar_class_t1_alloc +class(t1), pointer :: scalar_class_t1_ptr + +class(t1), allocatable :: array_class_t1_alloc(:,:) +class(t1), pointer :: array_class_t1_ptr(:,:) + +scalar_char_ptr => null() +scalar_t3_ptr => null() + +call sub_scalar (presnt=.false.) +call sub_scalar (scalar_real_alloc, .false.) +call sub_scalar (scalar_char_ptr, .false.) +call sub_scalar (null (), .false.) +call sub_scalar (scalar_t2_alloc, .false.) +call sub_scalar (scalar_t3_ptr, .false.) + +allocate (scalar_real_alloc, scalar_char_ptr, scalar_t3_ptr) +allocate (scalar_class_t1_alloc, scalar_class_t1_ptr, scalar_t2_alloc) +allocate (array_real_alloc(3:5,2:4), array_char_ptr(-2:2,2)) +allocate (array_t2_alloc(3:5,2:4), array_t3_ptr(-2:2,2)) +allocate (array_class_t1_alloc(3,3), array_class_t1_ptr(4,4)) + +call sub_scalar (scalar_int, .true.) +call sub_scalar (scalar_real_alloc, .true.) +call sub_scalar (scalar_char_ptr, .true.) +call sub_scalar (array_int(2), .true.) +call sub_scalar (array_real_alloc(3,2), .true.) +call sub_scalar (array_char_ptr(0,1), .true.) +call sub_scalar (scalar_t1, .true.) +call sub_scalar (scalar_t2_alloc, .true.) +call sub_scalar (scalar_t3_ptr, .true.) +call sub_scalar (array_t1(2), .true.) +call sub_scalar (array_t2_alloc(3,2), .true.) +call sub_scalar (array_t3_ptr(0,1), .true.) +call sub_scalar (array_class_t1_alloc(2,1), .true.) +call sub_scalar (array_class_t1_ptr(3,3), .true.) + +call sub_array_assumed (array_int) +call sub_array_assumed (array_real_alloc) +call sub_array_assumed (array_char_ptr) +call sub_array_assumed (array_t1) +call sub_array_assumed (array_t2_alloc) +call sub_array_assumed (array_t3_ptr) +call sub_array_assumed (array_class_t1_alloc) +call sub_array_assumed (array_class_t1_ptr) + +deallocate (scalar_char_ptr, scalar_class_t1_ptr, array_char_ptr) +deallocate (array_class_t1_ptr, array_t3_ptr) +contains + subroutine sub(x) + integer :: x(:) + call sub_array_assumed (x) + end subroutine sub +end diff --git a/gcc/testsuite/gfortran.dg/typebound_assignment_5.f03 b/gcc/testsuite/gfortran.dg/typebound_assignment_5.f03 index f176b841fc0..e7c9126b35c 100644 --- a/gcc/testsuite/gfortran.dg/typebound_assignment_5.f03 +++ b/gcc/testsuite/gfortran.dg/typebound_assignment_5.f03 @@ -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. diff --git a/gcc/testsuite/gfortran.dg/typebound_assignment_5a.f03 b/gcc/testsuite/gfortran.dg/typebound_assignment_5a.f03 new file mode 100644 index 00000000000..b55b42b589c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_assignment_5a.f03 @@ -0,0 +1,39 @@ +! { dg-do run } +! +! PR fortran/49074 +! ICE on defined assignment with class arrays. + + module foo + type bar + integer :: i + + contains + + generic :: assignment (=) => assgn_bar + procedure, private :: assgn_bar + end type bar + + contains + + elemental subroutine assgn_bar (a, b) + class (bar), intent (inout) :: a + class (bar), intent (in) :: b + + select type (b) + type is (bar) + a%i = b%i + end select + + return + end subroutine assgn_bar + end module foo + + program main + use foo </cut>