From 980fa45eefc0ec8f71e1947a28938af28f6fdbb2 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sun, 10 Jun 2018 15:31:42 +0000 Subject: [PATCH] gfortran.h (gfc_expr): Add no_bounds_check field. 2018-06-10 Thomas Koenig * gfortran.h (gfc_expr): Add no_bounds_check field. * frontend-passes.c (get_array_inq_function): Set no_bounds_check on function and function argument. (inline_matmul_assign): Set no_bounds_check on zero expression and on lhs of zero expression. Also handle A1B2 case if realloc on assigment is active. * trans-array.c (gfc_conv_array_ref): Don't do range checking if expr has no_bounds_check set. (gfc_conv_expr_descriptor): Set no_bounds_check on ss if expr has it set. * trans-expr.c (gfc_trans_assignment_1): Set no_bounds_check on lss and lss if the corresponding expressions have it set. 2018-06-10 Thomas Koenig * gfortran.dg/inline_matmul_23.f90: New test. From-SVN: r261388 --- gcc/fortran/ChangeLog | 17 ++++++- gcc/fortran/frontend-passes.c | 44 ++++++++++++++----- gcc/fortran/gfortran.h | 4 ++ gcc/fortran/trans-array.c | 5 ++- gcc/fortran/trans-expr.c | 3 ++ gcc/testsuite/ChangeLog | 3 ++ .../gfortran.dg/inline_matmul_23.f90 | 13 ++++++ 7 files changed, 77 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/inline_matmul_23.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2d79ab1a3ed..2fea88d4219 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2018-06-10 Thomas Koenig + + * gfortran.h (gfc_expr): Add no_bounds_check field. + * frontend-passes.c (get_array_inq_function): Set no_bounds_check + on function and function argument. + (inline_matmul_assign): Set no_bounds_check on zero expression + and on lhs of zero expression. + Also handle A1B2 case if realloc on assigment is active. + * trans-array.c (gfc_conv_array_ref): Don't do range checking + if expr has no_bounds_check set. + (gfc_conv_expr_descriptor): Set no_bounds_check on ss if expr + has it set. + * trans-expr.c (gfc_trans_assignment_1): Set no_bounds_check + on lss and lss if the corresponding expressions have it set. + 2018-06-10 Dominique d'Humieres PR fortran/79854 @@ -13,7 +28,7 @@ * gfortran.h: Add a comment to sym_intent. 2018-06-09 Steven G. Kargl - + PR fortran/38351 * resolve.c (resolve_operator): Provide better error message for derived type entity used in an binary intrinsic numeric operator. diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index c13366cf138..6d3a12ac570 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -2938,9 +2938,14 @@ get_array_inq_function (gfc_isym_id id, gfc_expr *e, int dim) gfc_index_integer_kind); ec = gfc_copy_expr (e); + + /* No bounds checking, this will be done before the loops if -fcheck=bounds + is in effect. */ + ec->no_bounds_check = 1; fcn = gfc_build_intrinsic_call (current_ns, id, name, e->where, 3, ec, dim_arg, kind); gfc_simplify_expr (fcn, 0); + fcn->no_bounds_check = 1; return fcn; } @@ -3645,6 +3650,9 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index, int count_index) } } + /* Bounds checking will be done before the loops if -fcheck=bounds + is in effect. */ + e->no_bounds_check = 1; return e; } @@ -3832,7 +3840,7 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees, m_case = A1B2; } } - + if (m_case == none) return 0; @@ -3911,10 +3919,13 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees, next_code_point = &if_limit->block->next; } + zero_e->no_bounds_check = 1; + assign_zero = XCNEW (gfc_code); assign_zero->op = EXEC_ASSIGN; assign_zero->loc = co->loc; assign_zero->expr1 = gfc_copy_expr (expr1); + assign_zero->expr1->no_bounds_check = 1; assign_zero->expr2 = zero_e; /* Handle the reallocation, if needed. */ @@ -3926,20 +3937,33 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees, bounds checking, the rest will be allocated. Also check this for A2B1. */ - if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && (m_case == A2B2 || m_case == A2B1)) + if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) { gfc_code *test; - gfc_expr *a2, *b1; + if (m_case == A2B2 || m_case == A2B1) + { + gfc_expr *a2, *b1; - a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); - b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); - test = runtime_error_ne (b1, a2, "Dimension of array B incorrect " - "in MATMUL intrinsic: Is %ld, should be %ld"); - *next_code_point = test; - next_code_point = &test->next; + a2 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 2); + b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); + test = runtime_error_ne (b1, a2, "Dimension of array B incorrect " + "in MATMUL intrinsic: Is %ld, should be %ld"); + *next_code_point = test; + next_code_point = &test->next; + } + else if (m_case == A1B2) + { + gfc_expr *a1, *b1; + + a1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_a, 1); + b1 = get_array_inq_function (GFC_ISYM_SIZE, matrix_b, 1); + test = runtime_error_ne (b1, a1, "Dimension of array B incorrect " + "in MATMUL intrinsic: Is %ld, should be %ld"); + *next_code_point = test; + next_code_point = &test->next; + } } - lhs_alloc = matmul_lhs_realloc (expr1, matrix_a, matrix_b, m_case); *next_code_point = lhs_alloc; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 113ed3c1e63..1d98d2554c7 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2145,6 +2145,10 @@ typedef struct gfc_expr /* Will require finalization after use. */ unsigned int must_finalize : 1; + /* Set this if no range check should be performed on this expression. */ + + unsigned int no_bounds_check : 1; + /* If an expression comes from a Hollerith constant or compile-time evaluation of a transfer statement, it may have a prescribed target- memory representation, and these cannot always be backformed from diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 97c47252435..193411c2674 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3583,7 +3583,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type); gfc_add_block_to_block (&se->pre, &indexse.pre); - if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) + if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && ! expr->no_bounds_check) { /* Check array bounds. */ tree cond; @@ -7181,6 +7181,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) /* The right-hand side of a pointer assignment mustn't use a temporary. */ gcc_assert (!se->direct_byref); + /* Do we need bounds checking or not? */ + ss->no_bounds_check = expr->no_bounds_check; + /* Setup the scalarizing loops and bounds. */ gfc_conv_ss_startstride (&loop); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index f85595177c6..b2a645beba4 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -9991,6 +9991,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, || expr2->value.function.isym->conversion))) lss->is_alloc_lhs = 1; } + else + lss->no_bounds_check = expr1->no_bounds_check; rss = NULL; @@ -10045,6 +10047,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, if (is_poly_assign && expr2->rank == 0 && !UNLIMITED_POLY (expr2)) rss->info->type = GFC_SS_REFERENCE; + rss->no_bounds_check = expr2->no_bounds_check; /* Associate the SS with the loop. */ gfc_add_ss_to_loop (&loop, lss); gfc_add_ss_to_loop (&loop, rss); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8693372a3cf..34f298fdd6a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,6 @@ +2018-06-10 Thomas Koenig + + * gfortran.dg/inline_matmul_23.f90: New test. 2018-06-10 Janus Weil diff --git a/gcc/testsuite/gfortran.dg/inline_matmul_23.f90 b/gcc/testsuite/gfortran.dg/inline_matmul_23.f90 new file mode 100644 index 00000000000..05633bc4d0b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inline_matmul_23.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! { dg-options "-Og -fcheck=bounds -fdump-tree-optimized" } +! Check that bounds checking is done only before the matrix +! multiplication. + +module y +contains + subroutine x(a,b,c) + real, dimension(:,:) :: a, b, c + c = matmul(a,b) + end subroutine x +end module y +! { dg-final { scan-tree-dump-times "_runtime_error" 3 "optimized" } }