From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x42d.google.com (mail-wr1-x42d.google.com [IPv6:2a00:1450:4864:20::42d]) by sourceware.org (Postfix) with ESMTPS id 3091E38515F3; Thu, 10 Jun 2021 10:24:41 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 3091E38515F3 Received: by mail-wr1-x42d.google.com with SMTP id q5so1669882wrm.1; Thu, 10 Jun 2021 03:24:41 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:date:from:to:cc:subject:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=lRm+5mNIAr5MlO+HmHD55xKH+VvCXcrr3yT4WkvCsSA=; b=iv9Qd7VPCaOCMdMRy9JMvc5dZo9T7w2PnLE+tYCJX4GtODaWcqA5bRV/k3+pXUFWGX lOcQwDRnwmSc9GUdRKvgItH4qRtowcFtYGlF8XKocLj0BEK262ibPGTCndvGM3NhmatD NrOASoXhBeNWg5kHEts7SL961PLh9lu5yDKrOjnNVD+44p/QM2EHxtDR0C3YOEKevnbC yoMvYj4WdfgOBA4mCNlo53IbM+8SVzSPLDRKo++qtlCBOlVkcd7/8lIZJpo4YwDdpY8M KMzniLEzr1I5VIcKF0zDT9I/ah77G5uBrUChT1+ysOuI69NtOpiN0br/A4Bd8Qo6H2ND Nd9g== X-Gm-Message-State: AOAM5302BjBHEvwyRAhWc1hp9wlBpn7INqSbllXn50Cz2pUcFZiH1glq xf+SfjE/UcnI4x3MkNcIeeM= X-Google-Smtp-Source: ABdhPJxLScTGTKfDT279/7pfPW61LccmRgUZlm8d1/U1KWeyh2Wq1bRUhSWUQt5PafoiuHYhe7OUeg== X-Received: by 2002:a05:6000:1148:: with SMTP id d8mr4647548wrx.266.1623320680242; Thu, 10 Jun 2021 03:24:40 -0700 (PDT) Received: from nbbrfq (91-119-97-5.dsl.dynamic.surfer.at. [91.119.97.5]) by smtp.gmail.com with ESMTPSA id a12sm2441494wmj.36.2021.06.10.03.24.39 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 10 Jun 2021 03:24:40 -0700 (PDT) Date: Thu, 10 Jun 2021 12:24:35 +0200 From: Bernhard Reutner-Fischer To: Harald Anlauf via Gcc-patches Cc: rep.dot.nop@gmail.com, Harald Anlauf , fortran Subject: Re: [PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514 Message-ID: <20210610122435.296a207d@nbbrfq> In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit X-Spam-Status: No, score=-9.1 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, KAM_NUMSUBJECT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 10 Jun 2021 10:24:42 -0000 On Wed, 9 Jun 2021 23:39:45 +0200 Harald Anlauf via Gcc-patches wrote: > diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c > index c27b47aa98f..016ec259518 100644 > --- a/gcc/fortran/simplify.c > +++ b/gcc/fortran/simplify.c > @@ -4512,6 +4512,60 @@ gfc_simplify_leadz (gfc_expr *e) > } > > > +/* Check for constant length of a substring. */ > + > +static bool > +substring_has_constant_len (gfc_expr *e) > +{ > + ptrdiff_t istart, iend; > + size_t length; > + bool equal_length = false; > + > + if (e->ts.type != BT_CHARACTER > + || !(e->ref && e->ref->type == REF_SUBSTRING) iff we ever can get here with e->ref == NULL then the below will not work too well. If so then maybe if (e->ts.type != BT_CHARACTER || ! e->ref || e->ref->type != REF_SUBSTRING ? > + || !e->ref->u.ss.start > + || e->ref->u.ss.start->expr_type != EXPR_CONSTANT > + || !e->ref->u.ss.end > + || e->ref->u.ss.end->expr_type != EXPR_CONSTANT > + || !e->ref->u.ss.length > + || !e->ref->u.ss.length->length > + || e->ref->u.ss.length->length->expr_type != EXPR_CONSTANT) > + return false; > + > + /* Basic checks on substring starting and ending indices. */ > + if (!gfc_resolve_substring (e->ref, &equal_length)) > + return false; > + > + istart = gfc_mpz_get_hwi (e->ref->u.ss.start->value.integer); > + iend = gfc_mpz_get_hwi (e->ref->u.ss.end->value.integer); > + length = gfc_mpz_get_hwi (e->ref->u.ss.length->length->value.integer); > + > + if (istart <= iend) > + { > + if (istart < 1) > + { > + gfc_error ("Substring start index (%ld) at %L below 1", > + (long) istart, &e->ref->u.ss.start->where); > + return false; > + } > + if (iend > (ssize_t) length) > + { > + gfc_error ("Substring end index (%ld) at %L exceeds string " > + "length", (long) iend, &e->ref->u.ss.end->where); > + return false; > + } > + length = iend - istart + 1; > + } > + else > + length = 0; > + > + /* Fix substring length. */ > + e->value.character.length = length; > + > + return true; > +} > + > + > gfc_expr * > gfc_simplify_len (gfc_expr *e, gfc_expr *kind) > { > @@ -4547,6 +4601,13 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind) > of the unlimited polymorphic entity. To get the _len component the last > _data ref needs to be stripped and a ref to the _len component added. */ > return gfc_get_len_component (e->symtree->n.sym->assoc->target, k); > + else if (substring_has_constant_len (e)) > + { > + result = gfc_get_constant_expr (BT_INTEGER, k, &e->where); > + mpz_set_si (result->value.integer, > + e->value.character.length); I think the mpz_set_si args above fit on one line. btw.. there's a commentary typo in add_init_expr_to_sym(): s/skeep/skip/ thanks, > + return range_check (result, "LEN"); > + } > else > return NULL; > } > diff --git a/gcc/testsuite/gfortran.dg/pr100950.f90 b/gcc/testsuite/gfortran.dg/pr100950.f90 > new file mode 100644 > index 00000000000..f06db45b0b4 > --- /dev/null > +++ b/gcc/testsuite/gfortran.dg/pr100950.f90 > @@ -0,0 +1,18 @@ > +! { dg-do run } > +! PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514 > + > +program p > + character(8), parameter :: u = "123" > + character(8) :: x = "", s > + character(2) :: w(2) = [character(len(x(3:4))) :: 'a','b' ] > + character(*), parameter :: y(*) = [character(len(u(3:4))) :: 'a','b' ] > + character(*), parameter :: z(*) = [character(len(x(3:4))) :: 'a','b' ] > + if (len (y) /= 2) stop 1 > + if (len (z) /= 2) stop 2 > + if (any (w /= y)) stop 3 > + if (len ([character(len(u(3:4))) :: 'a','b' ]) /= 2) stop 4 > + if (len ([character(len(x(3:4))) :: 'a','b' ]) /= 2) stop 5 > + if (any ([character(len(x(3:4))) :: 'a','b' ] /= y)) stop 6 > + write(s,*) [character(len(x(3:4))) :: 'a','b' ] > + if (s /= " a b ") stop 7 > +end