gfortran.h (gfc_expr): Add no_bounds_check field.

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  Thomas Koenig  <tkoenig@gcc.gnu.org>

	* gfortran.dg/inline_matmul_23.f90: New test.

From-SVN: r261388

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;