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 <tkoe...@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 <tkoe...@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 <tkoe...@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-arm-spec2k6-O2/22/artifact/artifacts/build-14688b8de389740f07079a945edf887a682fc9d1/
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-arm-spec2k6-O2/22/artifact/artifacts/build-bf09e559b22b44e74a91ccc00507a1885ec3d578/
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-arm-spec2k6-O2/22/
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-arm-spec2k6-O2/22/artifact/artifacts/manifests/build-baseline.sh
--fail
curl -o artifacts/manifests/build-parameters.sh
https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-arm-spec2k6-O2/22/artifact/artifacts/manifests/build-parameters.sh
--fail
curl -o artifacts/test.sh
https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-arm-spec2k6-O2/22/artifact/artifacts/test.sh
--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/ci/tcwg_bmk_gnu_tk1/gnu-release-arm-spec2k6-O2
Artifacts:
https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-arm-spec2k6-O2/22/artifact/artifacts/
Build log:
https://ci.linaro.org/job/tcwg_bmk_ci_gnu-bisect-tcwg_bmk_tk1-gnu-release-arm-spec2k6-O2/22/consoleText
Full commit (up to 1000 lines):
<cut>
commit bf09e559b22b44e74a91ccc00507a1885ec3d578
Author: Thomas Koenig <tkoe...@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 <tkoe...@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 <tkoe...@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 <jv...@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>
_______________________________________________
linaro-toolchain mailing list
linaro-toolchain@lists.linaro.org
https://lists.linaro.org/mailman/listinfo/linaro-toolchain
