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

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.

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;

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

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);
 

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);

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>
 

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" } }