From patchwork Mon Feb 18 22:48:34 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1044360 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-496591-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=gmx.de Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="j5PYTf9o"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 443Jvd6nHrz9s3x for ; Tue, 19 Feb 2019 09:49:17 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=Pa6RoBj91uvWn86BdhyOrGVYK+TXOUF9Iy2BVcuAE1MNQX /wTCAsR6fZT0poF8+26pddeDWxz8Uvq7oS3xqbx2Jlm2XnWqzI4/GdFrukmFgGfO ilsOwNRZa+SjtLP6iogBbgBPLw1wnhtx7yNlZGWEMwVP3iGwYWlMguxIk5HpI= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=1OY50eT9994kGYt0Z24Lxm3eI+4=; b=j5PYTf9oPcNaY1i042DH QjFBh8aZ3pw9t/traVmIa8AGUiExjeXP4m0rdfI4pQvhR+s3/WY2k17qRiaGs3Vo cM+9pj6PDWeVGg9t4KnYq9dHl7S6eYCiSAOjjjVl03AZh2MdUerCZF8ZcophDSdx 3dKJWdcj25HSSeE5pIzSup4= Received: (qmail 97513 invoked by alias); 18 Feb 2019 22:49:10 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 90519 invoked by uid 89); 18 Feb 2019 22:49:00 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.1 required=5.0 tests=BAYES_00, FREEMAIL_FROM, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, SPF_FAIL autolearn=ham version=3.3.2 spammy=mold, TRANSFER X-HELO: eggs.gnu.org Received: from eggs.gnu.org (HELO eggs.gnu.org) (209.51.188.92) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 18 Feb 2019 22:48:56 +0000 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gvriT-0002P4-Gs for gcc-patches@gcc.gnu.org; Mon, 18 Feb 2019 17:48:51 -0500 Received: from mout.gmx.net ([212.227.15.19]:57705) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gvriT-0002NY-0k for gcc-patches@gcc.gnu.org; Mon, 18 Feb 2019 17:48:49 -0500 Received: from proton.at.home ([93.207.87.43]) by mail.gmx.com (mrgmx002 [212.227.17.190]) with ESMTPSA (Nemesis) id 0Mb7lL-1gbJkw0mZH-00Kg9K; Mon, 18 Feb 2019 23:48:41 +0100 Message-ID: <5C6B3642.8000306@gmx.de> Date: Mon, 18 Feb 2019 23:48:34 +0100 From: Harald Anlauf User-Agent: Mozilla/5.0 (X11; Linux i686; rv:17.0) Gecko/20130329 Thunderbird/17.0.5 MIME-Version: 1.0 To: gfortran , gcc-patches Subject: [PR fortran/89266, patch] - ICE with TRANSFER of len=0 character array constructor X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 212.227.15.19 The issue in the PR is caused during simplification in the frontend because it does not properly differentiate between expressions of size 0 (e.g. arrays of length 0 or character strings of len=0) and failure. The attached patch tries to solve this problem by modifying the helper functions gfc_element_size and gfc_target_expr_size to return a bool when simplification fails. All users of these functions needed adjustment, most of which was more or less mechanical. There was one case left (in check.c) where I am unsure if I got the logic right. In the worst case it should produce a new bug for code that would have generated an ICE before. Since the above fix also works for non-character arrays of length 0, I added a suitable test. Regtested on x86_64-pc-linux-gnu. OK for trunk? Or rather wait for post-9.1? Thanks, Harald 2019-02-18 Harald Anlauf PR fortran/89266 * 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-18 Harald Anlauf PR fortran/89266 * gfortran.dg/pr89266.f90: New test. Index: gcc/testsuite/gfortran.dg/pr89266.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pr89266.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/pr89266.f90 (working copy) @@ -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 Index: gcc/fortran/arith.c =================================================================== --- gcc/fortran/arith.c (revision 268993) +++ gcc/fortran/arith.c (working copy) @@ -2548,10 +2548,10 @@ 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) { Index: gcc/fortran/check.c =================================================================== --- gcc/fortran/check.c (revision 268993) +++ gcc/fortran/check.c (working copy) @@ -5480,16 +5480,15 @@ 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; Index: gcc/fortran/class.c =================================================================== --- gcc/fortran/class.c (revision 268993) +++ gcc/fortran/class.c (working copy) @@ -2666,6 +2666,7 @@ 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, @@ -2700,11 +2701,13 @@ 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. */ Index: gcc/fortran/simplify.c =================================================================== --- gcc/fortran/simplify.c (revision 268993) +++ gcc/fortran/simplify.c (working copy) @@ -7379,6 +7379,7 @@ { gfc_expr *result = NULL; mpz_t array_size; + size_t res_size; if (x->ts.type == BT_CLASS || x->ts.deferred) return NULL; @@ -7394,7 +7395,8 @@ 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; } @@ -7408,6 +7410,7 @@ { gfc_expr *result = NULL; int k; + size_t siz; if (x->ts.type == BT_CLASS || x->ts.deferred) return NULL; @@ -7423,7 +7426,8 @@ 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"); Index: gcc/fortran/target-memory.c =================================================================== --- gcc/fortran/target-memory.c (revision 268993) +++ gcc/fortran/target-memory.c (working copy) @@ -73,10 +73,10 @@ /* 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; @@ -83,16 +83,20 @@ 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 @@ 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 @@ 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 @@ /* 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,8 +738,10 @@ 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); Index: gcc/fortran/target-memory.h =================================================================== --- gcc/fortran/target-memory.h (revision 268993) +++ gcc/fortran/target-memory.h (working copy) @@ -24,8 +24,8 @@ /* 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 *,