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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2d79ab1a3ed455a392beb4ce932d6e11e04ae108..2fea88d42193ef04001cd87218414e9c36f80702 100644 (file)
--- 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 c13366cf138276fc3817d1a38b5ea1d6930954a9..6d3a12ac5704215e8ec68d14fa4992fc9992a78f 100644 (file)
--- 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 113ed3c1e633d476f525337bbac40bfc2f7e149c..1d98d2554c739b09b67fffb0b4656fb4a818344c 100644 (file)
--- 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 97c47252435d87eca1552352c1dd645bb3c5af9c..193411c2674c827291887c9dddc3155123a35d58 100644 (file)
--- 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 f85595177c65e6d0c03dd2622ae13c10c03929bd..b2a645beba48bcfea0047dee1fc3a1fce2775bad 100644 (file)
--- 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 8693372a3cf4db48f9cb460cae43f997f16e7560..34f298fdd6a2dfc92ab94df2796e9cb9a98a35c6 100644 (file)
--- 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 (file)
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" } }