From cdd1793162ce3a8dc1c0d067f1af173eee98da0f Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Sun, 24 Feb 2019 20:03:28 +0000 Subject: [PATCH] re PR fortran/89266 (ICE with TRANSFER of len=0 character array constructor) 2019-02-24 Harald Anlauf PR fortran/89266 PR fortran/88326 * target-memory.c (gfc_element_size): Return false if element size cannot be determined; element size is returned separately. (gfc_target_expr_size): Return false if expression size cannot be determined; expression size is returned separately. * target-memory.h: Adjust prototypes. * check.c (gfc_calculate_transfer_sizes): Adjust references to gfc_target_expr_size, gfc_element_size. * arith.c (hollerith2representation): Likewise. * class.c (find_intrinsic_vtab): Likewise. * simplify.c (gfc_simplify_sizeof): Likewise. PR fortran/89266 PR fortran/88326 * gfortran.dg/pr89266.f90: New test. * gfortran.dg/pr88326.f90: New test. From-SVN: r269177 --- gcc/fortran/ChangeLog | 15 +++++++ gcc/fortran/arith.c | 4 +- gcc/fortran/check.c | 9 ++--- gcc/fortran/class.c | 9 +++-- gcc/fortran/simplify.c | 8 +++- gcc/fortran/target-memory.c | 58 ++++++++++++++++++--------- gcc/fortran/target-memory.h | 4 +- gcc/testsuite/ChangeLog | 7 ++++ gcc/testsuite/gfortran.dg/pr88326.f90 | 11 +++++ gcc/testsuite/gfortran.dg/pr89266.f90 | 25 ++++++++++++ 10 files changed, 116 insertions(+), 34 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr88326.f90 create mode 100644 gcc/testsuite/gfortran.dg/pr89266.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 580d4b7fb7a..db151a884c7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2019-02-24 Harald Anlauf + + PR fortran/89266 + PR fortran/88326 + * target-memory.c (gfc_element_size): Return false if element size + cannot be determined; element size is returned separately. + (gfc_target_expr_size): Return false if expression size cannot be + determined; expression size is returned separately. + * target-memory.h: Adjust prototypes. + * check.c (gfc_calculate_transfer_sizes): Adjust references to + gfc_target_expr_size, gfc_element_size. + * arith.c (hollerith2representation): Likewise. + * class.c (find_intrinsic_vtab): Likewise. + * simplify.c (gfc_simplify_sizeof): Likewise. + 2019-02-23 Jerry DeLisle PR fortran/84387 diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 425345c99a3..52d3a38b646 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -2548,10 +2548,10 @@ gfc_character2character (gfc_expr *src, int kind) static void hollerith2representation (gfc_expr *result, gfc_expr *src) { - int src_len, result_len; + size_t src_len, result_len; src_len = src->representation.length - src->ts.u.pad; - result_len = gfc_target_expr_size (result); + gfc_target_expr_size (result, &result_len); if (src_len > result_len) { diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index c60de6b5e4d..0367c92ed4b 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -5480,16 +5480,15 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size, return false; /* Calculate the size of the source. */ - *source_size = gfc_target_expr_size (source); - if (*source_size == 0) + if (!gfc_target_expr_size (source, source_size)) return false; /* Determine the size of the element. */ - result_elt_size = gfc_element_size (mold); - if (result_elt_size == 0) + if (!gfc_element_size (mold, &result_elt_size)) return false; - if (mold->expr_type == EXPR_ARRAY || mold->rank || size) + if ((result_elt_size > 0 && (mold->expr_type == EXPR_ARRAY || mold->rank)) + || size) { int result_length; diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index bcbe6318a4e..3f23556e726 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -2674,6 +2674,7 @@ find_intrinsic_vtab (gfc_typespec *ts) gfc_namespace *sub_ns; gfc_namespace *contained; gfc_expr *e; + size_t e_size; gfc_get_symbol (name, ns, &vtype); if (!gfc_add_flavor (&vtype->attr, FL_DERIVED, NULL, @@ -2708,11 +2709,13 @@ find_intrinsic_vtab (gfc_typespec *ts) e = gfc_get_expr (); e->ts = *ts; e->expr_type = EXPR_VARIABLE; + if (ts->type == BT_CHARACTER) + e_size = ts->kind; + else + gfc_element_size (e, &e_size); c->initializer = gfc_get_int_expr (gfc_size_kind, NULL, - ts->type == BT_CHARACTER - ? ts->kind - : gfc_element_size (e)); + e_size); gfc_free_expr (e); /* Add component _extends. */ diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 942f2eea3fc..6c1f4bd4fce 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -7383,6 +7383,7 @@ gfc_simplify_sizeof (gfc_expr *x) { gfc_expr *result = NULL; mpz_t array_size; + size_t res_size; if (x->ts.type == BT_CLASS || x->ts.deferred) return NULL; @@ -7398,7 +7399,8 @@ gfc_simplify_sizeof (gfc_expr *x) result = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind, &x->where); - mpz_set_si (result->value.integer, gfc_target_expr_size (x)); + gfc_target_expr_size (x, &res_size); + mpz_set_si (result->value.integer, res_size); return result; } @@ -7412,6 +7414,7 @@ gfc_simplify_storage_size (gfc_expr *x, { gfc_expr *result = NULL; int k; + size_t siz; if (x->ts.type == BT_CLASS || x->ts.deferred) return NULL; @@ -7427,7 +7430,8 @@ gfc_simplify_storage_size (gfc_expr *x, result = gfc_get_constant_expr (BT_INTEGER, k, &x->where); - mpz_set_si (result->value.integer, gfc_element_size (x)); + gfc_element_size (x, &siz); + mpz_set_si (result->value.integer, siz); mpz_mul_ui (result->value.integer, result->value.integer, BITS_PER_UNIT); return range_check (result, "STORAGE_SIZE"); diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 69879c2795a..09af2a56818 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -73,26 +73,30 @@ size_character (gfc_charlen_t length, int kind) /* Return the size of a single element of the given expression. - Identical to gfc_target_expr_size for scalars. */ + Equivalent to gfc_target_expr_size for scalars. */ -size_t -gfc_element_size (gfc_expr *e) +bool +gfc_element_size (gfc_expr *e, size_t *siz) { tree type; switch (e->ts.type) { case BT_INTEGER: - return size_integer (e->ts.kind); + *siz = size_integer (e->ts.kind); + return true; case BT_REAL: - return size_float (e->ts.kind); + *siz = size_float (e->ts.kind); + return true; case BT_COMPLEX: - return size_complex (e->ts.kind); + *siz = size_complex (e->ts.kind); + return true; case BT_LOGICAL: - return size_logical (e->ts.kind); + *siz = size_logical (e->ts.kind); + return true; case BT_CHARACTER: if (e->expr_type == EXPR_CONSTANT) - return size_character (e->value.character.length, e->ts.kind); + *siz = size_character (e->value.character.length, e->ts.kind); else if (e->ts.u.cl != NULL && e->ts.u.cl->length != NULL && e->ts.u.cl->length->expr_type == EXPR_CONSTANT && e->ts.u.cl->length->ts.type == BT_INTEGER) @@ -100,13 +104,18 @@ gfc_element_size (gfc_expr *e) HOST_WIDE_INT length; gfc_extract_hwi (e->ts.u.cl->length, &length); - return size_character (length, e->ts.kind); + *siz = size_character (length, e->ts.kind); } else - return 0; + { + *siz = 0; + return false; + } + return true; case BT_HOLLERITH: - return e->representation.length; + *siz = e->representation.length; + return true; case BT_DERIVED: case BT_CLASS: case BT_VOID: @@ -120,36 +129,43 @@ gfc_element_size (gfc_expr *e) type = gfc_typenode_for_spec (&ts); size = int_size_in_bytes (type); gcc_assert (size >= 0); - return size; + *siz = size; } + return true; default: gfc_internal_error ("Invalid expression in gfc_element_size."); - return 0; + *siz = 0; + return false; } + return true; } /* Return the size of an expression in its target representation. */ -size_t -gfc_target_expr_size (gfc_expr *e) +bool +gfc_target_expr_size (gfc_expr *e, size_t *size) { mpz_t tmp; - size_t asz; + size_t asz, el_size; gcc_assert (e != NULL); + *size = 0; if (e->rank) { if (gfc_array_size (e, &tmp)) asz = mpz_get_ui (tmp); else - asz = 0; + return false; } else asz = 1; - return asz * gfc_element_size (e); + if (!gfc_element_size (e, &el_size)) + return false; + *size = asz * el_size; + return true; } @@ -675,7 +691,7 @@ expr_to_char (gfc_expr *e, locus *loc, /* Otherwise, use the target-memory machinery to write a bitwise image, appropriate to the target, in a buffer and check off the initialized part of the buffer. */ - len = gfc_target_expr_size (e); + gfc_target_expr_size (e, &len); buffer = (unsigned char*)alloca (len); len = gfc_target_encode_expr (e, buffer, len); @@ -722,7 +738,9 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, locus *loc, for (c = gfc_constructor_first (e->value.constructor); c; c = gfc_constructor_next (c)) { - size_t elt_size = gfc_target_expr_size (c->expr); + size_t elt_size; + + gfc_target_expr_size (c->expr, &elt_size); if (mpz_cmp_si (c->offset, 0) != 0) len = elt_size * (size_t)mpz_get_si (c->offset); diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h index 37ac22ff340..5e06c9ad8f1 100644 --- a/gcc/fortran/target-memory.h +++ b/gcc/fortran/target-memory.h @@ -24,8 +24,8 @@ along with GCC; see the file COPYING3. If not see /* Convert a BOZ to REAL or COMPLEX. */ bool gfc_convert_boz (gfc_expr *, gfc_typespec *); -size_t gfc_element_size (gfc_expr *); -size_t gfc_target_expr_size (gfc_expr *); +bool gfc_element_size (gfc_expr *, size_t *); +bool gfc_target_expr_size (gfc_expr *, size_t *); /* Write a constant expression in binary form to a target buffer. */ size_t gfc_encode_character (int, size_t, const gfc_char_t *, unsigned char *, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 707c827621e..804cf456fe4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2019-02-24 Harald Anlauf + + PR fortran/89266 + PR fortran/88326 + * gfortran.dg/pr89266.f90: New test. + * gfortran.dg/pr88326.f90: New test. + 2019-02-24 Jakub Jelinek PR rtl-optimization/89445 diff --git a/gcc/testsuite/gfortran.dg/pr88326.f90 b/gcc/testsuite/gfortran.dg/pr88326.f90 new file mode 100644 index 00000000000..3cde68369f4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr88326.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! +! PR fortran/88326 - ICE in gfc_conv_array_initializer + +program p + character, parameter :: x(3) = ['a','b','c'] + character :: y(1) = transfer('', x) ! { dg-error "Different shape for array assignment" } + character(0) :: z(1) = transfer('', x) ! { dg-error "Different shape for array assignment" } + character :: u(0) = transfer('', x) + print *, y, z, u +end diff --git a/gcc/testsuite/gfortran.dg/pr89266.f90 b/gcc/testsuite/gfortran.dg/pr89266.f90 new file mode 100644 index 00000000000..f078adeb4fc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr89266.f90 @@ -0,0 +1,25 @@ +! { dg-do run } +! +! PR fortran/89266 - ICE with TRANSFER of len=0 character array constructor + +program test + implicit none + character(*), parameter :: n = '' + character(*), parameter :: o = transfer ([''], n) + character(*), parameter :: p = transfer ( n , n) + character(*), parameter :: q = transfer ([n], n) + character(6), save :: r = transfer ([''], n) + character(6), save :: s = transfer ( n , n) + character(6), save :: t = transfer ([n], n) + integer, parameter :: a(0) = 0 + integer, parameter :: b(0) = transfer (a, a) + integer, save :: c(0) = transfer (a, a) + if (len (o) /= 0) stop 1 + if (len (p) /= 0) stop 2 + if (len (q) /= 0) stop 3 + if (r /= "") stop 4 + if (s /= "") stop 5 + if (t /= "") stop 6 + if (size (b) /= 0 .or. any (b /= 0)) stop 7 + if (size (c) /= 0 .or. any (c /= 0)) stop 8 +end program test -- 2.30.2