Please find attached a version of the patch that excludes implicitly
pure procedures from the bounds warning.
Cheers
Paul
On Tue, 24 Mar 2026 at 10:42, Paul Richard Thomas
<[email protected]> wrote:
>
> Hello all,
>
> The attached fixes the above regression. I would have pushed it as
> obvious were it not for my decision to warn for index expressions
> containing functions not declared to be pure. If the warning is
> thought to be OTT, I can remove it.
>
> Also, note the pointer assignment at the end, which demonstrates that
> this regression is not specific to the associate statement but to
> pointer expressions in general.
>
> Regtests with FC43/x86_64 - OK for all the affected branches?
>
> Cheers
>
> Paul
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 70cea46c6b0..a2da4fe7c7d 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3974,6 +3974,29 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
}
+/* Helper functions to detect impure functions in an expression. */
+
+static const char *impure_name = NULL;
+static bool
+expr_contains_impure_fcn (gfc_expr *e, gfc_symbol* sym ATTRIBUTE_UNUSED,
+ int* g ATTRIBUTE_UNUSED)
+{
+ if (e && e->expr_type == EXPR_FUNCTION
+ && !gfc_pure_function (e, &impure_name)
+ && !gfc_implicit_pure_function (e))
+ return true;
+
+ return false;
+}
+
+static bool
+gfc_expr_contains_impure_fcn (gfc_expr *e)
+{
+ impure_name = NULL;
+ return gfc_traverse_expr (e, NULL, &expr_contains_impure_fcn, 0);
+}
+
+
/* Generate code for bounds checking for elemental dimensions. */
static void
@@ -3996,10 +4019,17 @@ array_bound_check_elemental (gfc_se * se, gfc_ss * ss, gfc_expr * expr)
{
if (ar->dimen_type[dim] == DIMEN_ELEMENT)
{
+ if (gfc_expr_contains_impure_fcn (ar->start[dim]))
+ gfc_warning_now (0, "Bounds checking of the elemental "
+ "index at %L will cause two calls to "
+ "%qs, which is not declared to be "
+ "PURE or is not implicitly pure.",
+ &ar->start[dim]->where, impure_name);
gfc_se indexse;
gfc_init_se (&indexse, NULL);
gfc_conv_expr_type (&indexse, ar->start[dim],
gfc_array_index_type);
+ gfc_add_block_to_block (&se->pre, &indexse.pre);
trans_array_bound_check (se, ss, indexse.expr, dim,
&ar->where,
ar->as->type != AS_ASSUMED_SIZE
diff --git a/gcc/testsuite/gfortran.dg/pr119273.f90 b/gcc/testsuite/gfortran.dg/pr119273.f90
new file mode 100644
index 00000000000..212754ae0f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr119273.f90
@@ -0,0 +1,70 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcheck=bounds" }
+!
+! Test the fix forPR119273, which caused false bounds check errors.
+!
+! Contributed by Jingwei Xing <[email protected]>
+!
+module test_module
+ type :: test_type_father
+ integer :: val
+ contains
+ procedure :: test_function3
+ end type test_type_father
+
+ type, extends(test_type_father) :: test_type_child
+ contains
+ procedure :: test_function1
+ end type test_type_child
+
+ integer :: ii
+
+ contains
+ function test_function1(a) result(out)
+ class(test_type_child), intent(in) :: a
+ integer :: out
+ ii = a%val ! Make this function implicitly impure.
+ out = a%val
+ end function
+ pure function test_function2(a) result(out)
+ type(test_type_child), intent(in) :: a
+ integer :: out
+ out = a%val
+ end function
+ pure function test_function3(a) result(out)
+ class(test_type_father), intent(in) :: a
+ integer :: out
+ out = a%val
+ end function
+end module
+
+program test
+ use test_module
+ implicit none
+ type(test_type_child) :: a
+ type(test_type_father) :: b
+ class(test_type_child), allocatable :: c
+ integer, target :: temp_int(1,1)
+ integer, pointer :: d(:)
+ a%val = 0
+ associate(temp => temp_int(:,a%test_function1() + 1)) ! { dg-warning "is not implicitly pure" }
+ end associate
+ a%val = 1
+ associate(temp => temp_int(:,test_function2(a)))
+ end associate
+ b%val = 1
+ associate(temp => temp_int(:,b%test_function3()))
+ end associate
+ associate(temp => temp_int(:,test_function3(b)))
+ end associate
+ allocate (c, source = a)
+ associate(temp => temp_int(:,c%test_function1())) ! { dg-warning "is not implicitly pure" }
+ end associate
+
+! Demonstrate that this bug was not specific to the ASSOCIATE statement but,
+! rather to it being a pointer assignment, when the selector is a variable.
+ d => temp_int(:,a%test_function1()) ! { dg-warning "is not implicitly pure" }
+
+end program test
+! Test for the missing vptr assignments to the class actual temporaries.
+! { dg-final { scan-tree-dump-times "class..._vptr =" 8 "original" } }
