diff options
Diffstat (limited to 'gcc/fortran/frontend-passes.c')
-rw-r--r-- | gcc/fortran/frontend-passes.c | 46 |
1 files changed, 35 insertions, 11 deletions
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index c13366c..6d3a12a 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; - - 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; + 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; + } + 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; |