From: Steven G. Kargl Date: Fri, 26 Jan 2018 19:33:16 +0000 (+0000) Subject: re PR fortran/83998 (ICE in gfc_conv_intrinsic_dot_product, at fortran/trans-intrinsi... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=deece1aa0135de487e7846025efbc8f6cd79ffe2;p=gcc.git re PR fortran/83998 (ICE in gfc_conv_intrinsic_dot_product, at fortran/trans-intrinsic.c:4403) 2018-01-26 Steven G. Kargl 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 PR fortran/83998 * gfortran.dg/dot_product_4.f90 From-SVN: r257104 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d96ce8ec63a..659e8acfcc1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2018-01-26 Steven G. Kargl + + 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 PR fortran/37577 diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 1f88b5cf3a3..1e5e4233a6d 100644 --- 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 63bae36ea38..317be5e9fae 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-01-26 Steven G. Kargl + + PR fortran/83998 + * gfortran.dg/dot_product_4.f90 + 2018-01-26 Martin Sebor 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 index 00000000000..fe632027389 --- /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 +