diff options
Diffstat (limited to 'gcc/fortran/simplify.c')
| -rw-r--r-- | gcc/fortran/simplify.c | 38 |
1 files changed, 28 insertions, 10 deletions
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 37c04e9bf27..ac443d81f50 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -1,5 +1,5 @@ /* Simplify intrinsic functions at compile-time. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2016, 2018 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. @@ -1838,11 +1838,17 @@ gfc_simplify_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim) sz = mpz_get_si (size); mpz_clear (size); + /* Special case: Zero-sized array. */ + if (sz == 0) + return a; + /* Adjust shft to deal with right or left shifts. */ - shft = shft < 0 ? 1 - shft : shft; + shft = shft % sz; + if (shft < 0) + shft += sz; /* Special case: Shift to the original order! */ - if (sz == 0 || shft % sz == 0) + if (shft % sz == 0) return a; result = gfc_copy_expr (a); @@ -4011,10 +4017,23 @@ gfc_simplify_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) || !is_constant_array_expr (matrix_b)) return NULL; - gcc_assert (gfc_compare_types (&matrix_a->ts, &matrix_b->ts)); - result = gfc_get_array_expr (matrix_a->ts.type, - matrix_a->ts.kind, - &matrix_a->where); + /* MATMUL should do mixed-mode arithmetic. Set the result type. */ + if (matrix_a->ts.type != matrix_b->ts.type) + { + gfc_expr e; + e.expr_type = EXPR_OP; + gfc_clear_ts (&e.ts); + e.value.op.op = INTRINSIC_NONE; + e.value.op.op1 = matrix_a; + e.value.op.op2 = matrix_b; + gfc_type_convert_binary (&e, 1); + result = gfc_get_array_expr (e.ts.type, e.ts.kind, &matrix_a->where); + } + else + { + result = gfc_get_array_expr (matrix_a->ts.type, matrix_a->ts.kind, + &matrix_a->where); + } if (matrix_a->rank == 1 && matrix_b->rank == 2) { @@ -6355,8 +6374,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) return NULL; /* Calculate the size of the source. */ - if (source->expr_type == EXPR_ARRAY - && !gfc_array_size (source, &tmp)) + if (source->expr_type == EXPR_ARRAY && !gfc_array_size (source, &tmp)) gfc_internal_error ("Failure getting length of a constant array."); /* Create an empty new expression with the appropriate characteristics. */ @@ -6364,7 +6382,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) &source->where); result->ts = mold->ts; - mold_element = mold->expr_type == EXPR_ARRAY + mold_element = (mold->expr_type == EXPR_ARRAY && mold->value.constructor) ? gfc_constructor_first (mold->value.constructor)->expr : mold; |