PR fortran/83998 -- fix dot_product on 0-sized arrays

Message ID 20180125021147.GA52679@troutmask.apl.washington.edu
State New
Headers show
Series
  • PR fortran/83998 -- fix dot_product on 0-sized arrays
Related show

Commit Message

Steve Kargl Jan. 25, 2018, 2:11 a.m.
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

Comments

Thomas Koenig Jan. 25, 2018, 7:37 a.m. | #1
Hi Steve,

I have a couple of questions before I have to hurry off to work:

First, why is

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

> +    }


in front of

> -  gfc_expr temp;

> -

>     if (!is_constant_array_expr (vector_a)

>         || !is_constant_array_expr (vector_b))

>       return NULL;


and / or why is the test only done for one variable?

Second, why do you remove this

> -  temp.value.op.op = INTRINSIC_NONE;

> -  temp.value.op.op1 = vector_a;

> -  temp.value.op.op2 = vector_b;

> -  gfc_type_convert_binary (&temp, 1);


block of code? What would happen for code like

   integer, dimension(2), parameter :: a = [ 1,2]
   real, dimension(2), parameter :: b = [1.0,2.0]
   real, parameter :: c = dot_product(a,b)

?

Regards

	Thomas
Steve Kargl Jan. 25, 2018, 3:06 p.m. | #2
On Thu, Jan 25, 2018 at 08:37:54AM +0100, Thomas Koenig wrote:
> First, why is

> 

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

> > +    }

> 

> in front of


There are two problems with is_constant_array_expr.  First,
it doesn't handle zero-sized arrays.  It returns false, and
dot_product(a,a,) is not simplified.  The dot_product reaches
gfc_conv_intrinsic_dot_product, which tries to generate
in-line code, except it isn't prepared to deal with zero-sized
arrays and ICE occurs.  Second, with the code of the testcase
on entering gfc_simplify_dot_product, we have

vector_a->expr_type == EXPR_VARIABLE
vector_a->rank == 1
vector_a->shape == some_valid_pointer.

after is_constant_array_expr is called we have

vector_a->expr_type == EXPR_CONSTANT
vector_a->rank == 1
vector_a->shape == NULL.

This NULL does not play well gfc_conv_intrinsic_dot_product().
The testcase code arrives here where some_valid_pointer points
to a GMP entity with a value of 0, i.e., a zero-sized array.
So, gfortran can simplify dot_product as I have done
above.

> > -  gfc_expr temp;

> > -

> >     if (!is_constant_array_expr (vector_a)

> >         || !is_constant_array_expr (vector_b))

> >       return NULL;

> 

> and / or why is the test only done for one variable?


gfc_check_dot_product checks that shape of vector_a
and shape of vector_b are the same.  If vector_a is zero
sized, then so is vector_b.

> 

> Second, why do you remove this

> 

> > -  temp.value.op.op = INTRINSIC_NONE;

> > -  temp.value.op.op1 = vector_a;

> > -  temp.value.op.op2 = vector_b;

> > -  gfc_type_convert_binary (&temp, 1);

> 

> block of code?


It is dead code.  temp is set to the typespec of 
the mixed-mode math result, but it is never used.
compute_dot_product does the mixed-mode math,
because it uses gfc_add() from arith.c.

> What would happen for code like

> 

>    integer, dimension(2), parameter :: a = [ 1,2]

>    real, dimension(2), parameter :: b = [1.0,2.0]

>    real, parameter :: c = dot_product(a,b)


gfortran rejects it as it isn't a valid Fortran unit.  :-)

gfcx -fdump-tree-original -o z a.f90 && ./z
   5.00000000    

cat a.f90.003t.original
  {
    struct __st_parameter_dt dt_parm.0;

    dt_parm.0.common.filename = &"a.f90"[1]{lb: 1 sz: 1};
    dt_parm.0.common.line = 4;
    dt_parm.0.common.flags = 128;
    dt_parm.0.common.unit = 6;
    _gfortran_st_write (&dt_parm.0);
    {
      static real(kind=4) C.3752 = 5.0e+0;

      _gfortran_transfer_real_write (&dt_parm.0, &C.3752, 4);
    }
    _gfortran_st_write_done (&dt_parm.0);
  }

-- 
Steve
Steve Kargl Jan. 25, 2018, 6:24 p.m. | #3
On Thu, Jan 25, 2018 at 07:06:10AM -0800, Steve Kargl wrote:
> On Thu, Jan 25, 2018 at 08:37:54AM +0100, Thomas Koenig wrote:

> > 

> > Second, why do you remove this

> > 

> > > -  temp.value.op.op = INTRINSIC_NONE;

> > > -  temp.value.op.op1 = vector_a;

> > > -  temp.value.op.op2 = vector_b;

> > > -  gfc_type_convert_binary (&temp, 1);

> > 

> > block of code?

> 

> It is dead code.  temp is set to the typespec of 

> the mixed-mode math result, but it is never used.

> compute_dot_product does the mixed-mode math,

> because it uses gfc_add() from arith.c.

> 


Upon re-reading gfc_type_convert_binary, it isn't dead.
It simply isn't needed, because gfc_add() eventually
lands at arith.c (eval_intrinsics):

    /* Numeric binary  */
    case INTRINSIC_PLUS:
    case INTRINSIC_MINUS:
    case INTRINSIC_TIMES:
    case INTRINSIC_DIVIDE:
    case INTRINSIC_POWER:
      if (!gfc_numeric_ts (&op1->ts) || !gfc_numeric_ts (&op2->ts))
	goto runtime;

      /* Insert any necessary type conversions to make the operands
	 compatible.  */

      temp.expr_type = EXPR_OP;
      gfc_clear_ts (&temp.ts);
      temp.value.op.op = op;

      temp.value.op.op1 = op1;
      temp.value.op.op2 = op2;

      gfc_type_convert_binary (&temp, warn_conversion || warn_conversion_extra);

-- 
Steve
Thomas Koenig Jan. 25, 2018, 6:58 p.m. | #4
Hi Steve,

thanks for your explanations.

The patch is OK for trunk. Thanks a lot!

Regards

	Thomas
Steve Kargl Jan. 25, 2018, 7:07 p.m. | #5
On Thu, Jan 25, 2018 at 07:58:22PM +0100, Thomas Koenig wrote:
> Hi Steve,

> 

> thanks for your explanations.

> 

> The patch is OK for trunk. Thanks a lot!

> 


Upon even further reading, the code segment with temp might
be needed.  If one looks in compute_dot_product(), one finds

  result = gfc_get_constant_expr (matrix_a->ts.type, matrix_a->ts.kind,
				  &matrix_a->where);
  init_result_expr (result, 0, NULL);
 
which sets the type of result to matrix_a, unconditionally.
We may however still benefit from mixed-mode math during
the summation because we have

	    result = gfc_add (result, gfc_multiply (c, gfc_copy_expr (b)));

and both gfc_add and gfc_multiply should do mixed-mode math.

I'll check before I commit.

-- 
Steve
Steve Kargl Jan. 25, 2018, 7:19 p.m. | #6
On Thu, Jan 25, 2018 at 11:07:04AM -0800, Steve Kargl wrote:
> On Thu, Jan 25, 2018 at 07:58:22PM +0100, Thomas Koenig wrote:

> > Hi Steve,

> > 

> > thanks for your explanations.

> > 

> > The patch is OK for trunk. Thanks a lot!

> > 

> 

> Upon even further reading, the code segment with temp might

> be needed.  If one looks in compute_dot_product(), one finds

> 

>   result = gfc_get_constant_expr (matrix_a->ts.type, matrix_a->ts.kind,

> 				  &matrix_a->where);

>   init_result_expr (result, 0, NULL);

>  

> which sets the type of result to matrix_a, unconditionally.

> We may however still benefit from mixed-mode math during

> the summation because we have

> 

> 	    result = gfc_add (result, gfc_multiply (c, gfc_copy_expr (b)));

> 

> and both gfc_add and gfc_multiply should do mixed-mode math.

> 

> I'll check before I commit.


This code confirms proper handling of mixed-mode math.
   program p
   integer, parameter :: a(2) = [1, 2]
   real, parameter :: b(2) = [1., 2.]
   real c
   c = dot_product(a,b)
   print *, c
   end

-- 
Steve

Patch

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
+