re PR fortran/83998 (ICE in gfc_conv_intrinsic_dot_product, at fortran/trans-intrinsi...

2018-01-26  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/83998
	* simplify.c (compute_dot_product):  Initialize result to INTEGER(1) 0
	or .false.  The summation does the correct type conversion.
	(gfc_simplify_dot_product): Special case zero-sized arrays.

2018-01-26  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/83998
	* gfortran.dg/dot_product_4.f90

From-SVN: r257104

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d96ce8ec63a520cc22d9bc8fd42084a4c519328b..659e8acfcc1a7c8da3c8c0a77205893c37f455ef 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2018-01-26  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/83998
+       * simplify.c (compute_dot_product):  Initialize result to INTEGER(1) 0
+       or .false.  The summation does the correct type conversion.
+       (gfc_simplify_dot_product): Special case zero-sized arrays.
+
 2018-25-01  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/37577

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 1f88b5cf3a350b7323ee52df1479aefc580d43ef..1e5e4233a6d4807b8be2600fbc09da54a48696e0 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -354,9 +354,14 @@ compute_dot_product (gfc_expr *matrix_a, int stride_a, int offset_a,
 {
   gfc_expr *result, *a, *b, *c;
 
-  result = gfc_get_constant_expr (matrix_a->ts.type, matrix_a->ts.kind,
-                                 &matrix_a->where);
-  init_result_expr (result, 0, NULL);
+  /* Set result to an INTEGER(1) 0 for numeric types and .false. for 
+     LOGICAL.  Mixed-mode math in the loop will promote result to the
+     correct type and kind.  */
+  if (matrix_a->ts.type == BT_LOGICAL)
+    result = gfc_get_logical_expr (gfc_default_logical_kind, NULL, false);
+  else
+    result = gfc_get_int_expr (1, NULL, 0);
+  result->where = matrix_a->where;
 
   a = gfc_constructor_lookup_expr (matrix_a->value.constructor, offset_a);
   b = gfc_constructor_lookup_expr (matrix_b->value.constructor, offset_b);
@@ -2253,23 +2258,20 @@ gfc_simplify_dim (gfc_expr *x, gfc_expr *y)
 gfc_expr*
 gfc_simplify_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
 {
-
-  gfc_expr temp;
+  /* If vector_a is a zero-sized array, the result is 0 for INTEGER, 
+     REAL, and COMPLEX types and .false. for LOGICAL.  */
+  if (vector_a->shape && mpz_get_si (vector_a->shape[0]) == 0)
+    {
+      if (vector_a->ts.type == BT_LOGICAL)
+       return gfc_get_logical_expr (gfc_default_logical_kind, NULL, false);
+      else
+       return gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
+    }
 
   if (!is_constant_array_expr (vector_a)
       || !is_constant_array_expr (vector_b))
     return NULL;
 
-  gcc_assert (vector_a->rank == 1);
-  gcc_assert (vector_b->rank == 1);
-
-  temp.expr_type = EXPR_OP;
-  gfc_clear_ts (&temp.ts);
-  temp.value.op.op = INTRINSIC_NONE;
-  temp.value.op.op1 = vector_a;
-  temp.value.op.op2 = vector_b;
-  gfc_type_convert_binary (&temp, 1);
-
   return compute_dot_product (vector_a, 1, 0, vector_b, 1, 0, true);
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 63bae36ea38071a7c2df23603cfc1b2a57e6b517..317be5e9faefcd2f08e4c21c076541e83de615bc 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-01-26  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/83998
+       * gfortran.dg/dot_product_4.f90
+
 2018-01-26  Martin Sebor  <msebor@redhat.com>
 
        PR tree-optimization/83896

diff --git a/gcc/testsuite/gfortran.dg/dot_product_4.f90 b/gcc/testsuite/gfortran.dg/dot_product_4.f90
new file mode 100644 (file)
index 0000000..fe63202
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dot_product_4.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR fortran/83998
+program p
+   integer, parameter :: a(0) = 1
+   real, parameter :: b(0) = 1
+   complex, parameter :: c(0) = 1
+   logical, parameter :: d(0) = .true.
+   if (dot_product(a,a) /= 0) call abort
+   if (dot_product(b,b) /= 0) call abort
+   if (dot_product(c,c) /= 0) call abort
+   if (dot_product(d,d) .neqv. .false.) call abort
+end
+