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:

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

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

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

Hi Steve,

thanks for your explanations.

The patch is OK for trunk. Thanks a lot!

Regards

	Thomas

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.

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