This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] PR fortran/83998 -- fix dot_product on 0-sized arrays


All,

The attach patch fixes a regression with dot_product and
zero-sized arrays.  I bootstrapped and regression tested
the patch on x86_64-*-freebsd.  OK to commit?

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

	PR fortran/83998
  	* simplify.c (gfc_simplify_dot_product): Deal with zero-sized arrays.

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

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

-- 
Steve
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c	(revision 256953)
+++ gcc/fortran/simplify.c	(working copy)
@@ -2253,22 +2253,19 @@ gfc_simplify_dim (gfc_expr *x, gfc_expr *y)
 gfc_expr*
 gfc_simplify_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
 {
+  /* 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);
+    }
 
-  gfc_expr temp;
-
   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);
 }
Index: gcc/testsuite/gfortran.dg/dot_product_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/dot_product_4.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/dot_product_4.f90	(working copy)
@@ -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
+

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]