aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog17
-rw-r--r--gcc/fortran/frontend-passes.c46
-rw-r--r--gcc/fortran/gfortran.h4
-rw-r--r--gcc/fortran/trans-array.c5
-rw-r--r--gcc/fortran/trans-expr.c3
-rw-r--r--gcc/testsuite/ChangeLog3
-rw-r--r--gcc/testsuite/gfortran.dg/inline_matmul_23.f9013
7 files changed, 78 insertions, 13 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2d79ab1..2fea88d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+2018-06-10 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ * 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 <dominiq@gcc.gnu.org>
PR fortran/79854
@@ -13,7 +28,7 @@
* gfortran.h: Add a comment to sym_intent.
2018-06-09 Steven G. Kargl <kargl@gcc.gnu.org>
-
+
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 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;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 113ed3c..1d98d25 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 97c4725..193411c 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 f855951..b2a645b 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 8693372..34f298f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,6 @@
+2018-06-10 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ * gfortran.dg/inline_matmul_23.f90: New test.
2018-06-10 Janus Weil <janus@gcc.gnu.org>
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 0000000..05633bc
--- /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" } }
generated by cgit v1.1 at 2025-05-31 14:34:34 +0000