From patchwork Sun Sep 15 11:40:02 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 1162441 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-509012-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=fail (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="wddw1pps"; dkim=fail reason="signature verification failed" (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="oGOPfIKV"; 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 46WS9X34jQz9sPD for ; Sun, 15 Sep 2019 21:40:29 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:content-type; q= dns; s=default; b=HOB7+SH91fK+757ygLo2Awcq55M6Bj3Np/euvqN8T4c0OX oyfp561mGATgpYFKGJ/MKP4sm4WKZ65vJQvI7LF+04B6voH1E6w2m+jDLzLxGH/o B3LlKoOI0Q1NxXcJGCO18JCvnm06424lYjMww3ZX2YQeXSy9Qq4IKEQHIFPxU= 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 :mime-version:from:date:message-id:subject:to:content-type; s= default; bh=JHE1UxXgDacm1MAMiPfv24/RCVc=; b=wddw1ppsrClWpw2i1PSE +EsGGRE+Dv9w8d/ORMWWstuyxe/TmPeDzGF/nAFJg4JCZVGilruxJ4zE/hroHlEg WqvkDzHIcYFo87PV5ybRtSef9bMljOPJdohoPeniPuoYnNwr9PTGr4mkIAjBXHbg RSF4kO8rKTJjbnyniatb6SU= Received: (qmail 84854 invoked by alias); 15 Sep 2019 11:40:19 -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 84838 invoked by uid 89); 15 Sep 2019 11:40:19 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-3.7 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_2, KAM_ASCII_DIVIDERS, KAM_NUMSUBJECT, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=associate, 48, 275695, 4.8 X-HELO: mail-lf1-f46.google.com Received: from mail-lf1-f46.google.com (HELO mail-lf1-f46.google.com) (209.85.167.46) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 15 Sep 2019 11:40:17 +0000 Received: by mail-lf1-f46.google.com with SMTP id r22so13971918lfm.1; Sun, 15 Sep 2019 04:40:16 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=mime-version:from:date:message-id:subject:to; bh=iwYN6/8bjKCou0XV1Zu+iL3Q4kNNeeECM0hZBZ5L7uE=; b=oGOPfIKV0UI9BKAroXlBYaj9Hc56LWWWlTZcU7jFoN89qyjwpditgDcyLK43usgwh6 itMFfOvZVPB2+UQ74hexNN4myFr//D7cqlHC6VAxosCrr5f4X6CgjIJuA7B+/DJf1NeZ 860i8fLhQRuCQMl4MRQU8PCIE0JInpFXaeUYK4xk6KtQCWr3yR6uP4cnPRr8YqHcjUoG q+7xWq75bXp0TWElsFpreGvZSaeSGfSZLfF3lIRzyzDc6naHdfmHXVDMzkAANXd9Rsrl 9H0vfCf0SL/N5TjboC7KhOsIRp1iJIYX6d1CxhkbjE5aJ0DIWhBKhUDpuafqvSj4WuJn wc2g== MIME-Version: 1.0 From: Paul Richard Thomas Date: Sun, 15 Sep 2019 12:40:02 +0100 Message-ID: Subject: [Patch, fortran] PR91588 - ICE in check_inquiry, at fortran/expr.c:2673 To: "fortran@gcc.gnu.org" , gcc-patches The attached bootstraps and regtests on FC30/x86_64 - OK for trunk? It strikes me that this should be backported since the bug is rather fundamental and ispresent all the way back to version 4.8. An obvious question is how far back? To 8-branch? Cheers Paul 2019-09-15 Paul Thomas PR fortran/91588 * expr.c (check_inquiry): Remove extended component refs by using symbol pointers. If a function argument is an associate variable with a constant target, copy the target expression in place of the argument expression. Check that the charlen is not NULL before using the string length. (gfc_check_assign): Remove extraneous space. 2019-09-15 Paul Thomas PR fortran/91588 * gfortran.dg/associate_49.f90 : New test. Index: gcc/fortran/expr.c =================================================================== *** gcc/fortran/expr.c (revision 275695) --- gcc/fortran/expr.c (working copy) *************** check_inquiry (gfc_expr *e, int not_rest *** 2610,2615 **** --- 2610,2617 ---- int i = 0; gfc_actual_arglist *ap; + gfc_symbol *sym; + gfc_symbol *asym; if (!e->value.function.isym || !e->value.function.isym->inquiry) *************** check_inquiry (gfc_expr *e, int not_rest *** 2619,2638 **** if (e->symtree == NULL) return MATCH_NO; ! if (e->symtree->n.sym->from_intmod) { ! if (e->symtree->n.sym->from_intmod == INTMOD_ISO_FORTRAN_ENV ! && e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_OPTIONS ! && e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_VERSION) return MATCH_NO; ! if (e->symtree->n.sym->from_intmod == INTMOD_ISO_C_BINDING ! && e->symtree->n.sym->intmod_sym_id != ISOCBINDING_C_SIZEOF) return MATCH_NO; } else { ! name = e->symtree->n.sym->name; functions = inquiry_func_gnu; if (gfc_option.warn_std & GFC_STD_F2003) --- 2621,2642 ---- if (e->symtree == NULL) return MATCH_NO; ! sym = e->symtree->n.sym; ! ! if (sym->from_intmod) { ! if (sym->from_intmod == INTMOD_ISO_FORTRAN_ENV ! && sym->intmod_sym_id != ISOFORTRAN_COMPILER_OPTIONS ! && sym->intmod_sym_id != ISOFORTRAN_COMPILER_VERSION) return MATCH_NO; ! if (sym->from_intmod == INTMOD_ISO_C_BINDING ! && sym->intmod_sym_id != ISOCBINDING_C_SIZEOF) return MATCH_NO; } else { ! name = sym->name; functions = inquiry_func_gnu; if (gfc_option.warn_std & GFC_STD_F2003) *************** check_inquiry (gfc_expr *e, int not_rest *** 2657,2697 **** if (!ap->expr) continue; if (ap->expr->ts.type == BT_UNKNOWN) { ! if (ap->expr->symtree->n.sym->ts.type == BT_UNKNOWN ! && !gfc_set_default_type (ap->expr->symtree->n.sym, 0, gfc_current_ns)) return MATCH_NO; ! ap->expr->ts = ap->expr->symtree->n.sym->ts; } ! /* Assumed character length will not reduce to a constant expression ! with LEN, as required by the standard. */ ! if (i == 5 && not_restricted && ap->expr->symtree ! && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER ! && (ap->expr->symtree->n.sym->ts.u.cl->length == NULL ! || ap->expr->symtree->n.sym->ts.deferred)) ! { ! gfc_error ("Assumed or deferred character length variable %qs " ! "in constant expression at %L", ! ap->expr->symtree->n.sym->name, ! &ap->expr->where); ! return MATCH_ERROR; ! } ! else if (not_restricted && !gfc_check_init_expr (ap->expr)) ! return MATCH_ERROR; ! if (not_restricted == 0 ! && ap->expr->expr_type != EXPR_VARIABLE ! && !check_restricted (ap->expr)) return MATCH_ERROR; ! if (not_restricted == 0 ! && ap->expr->expr_type == EXPR_VARIABLE ! && ap->expr->symtree->n.sym->attr.dummy ! && ap->expr->symtree->n.sym->attr.optional) ! return MATCH_NO; } return MATCH_YES; --- 2661,2708 ---- if (!ap->expr) continue; + asym = ap->expr->symtree ? ap->expr->symtree->n.sym : NULL; + if (ap->expr->ts.type == BT_UNKNOWN) { ! if (asym && asym->ts.type == BT_UNKNOWN ! && !gfc_set_default_type (asym, 0, gfc_current_ns)) return MATCH_NO; ! ap->expr->ts = asym->ts; } ! if (asym && asym->assoc && asym->assoc->target ! && asym->assoc->target->expr_type == EXPR_CONSTANT) ! { ! gfc_free_expr (ap->expr); ! ap->expr = gfc_copy_expr (asym->assoc->target); ! } ! /* Assumed character length will not reduce to a constant expression ! with LEN, as required by the standard. */ ! if (i == 5 && not_restricted && asym ! && asym->ts.type == BT_CHARACTER ! && ((asym->ts.u.cl && asym->ts.u.cl->length == NULL) ! || asym->ts.deferred)) ! { ! gfc_error ("Assumed or deferred character length variable %qs " ! "in constant expression at %L", ! asym->name, &ap->expr->where); return MATCH_ERROR; + } + else if (not_restricted && !gfc_check_init_expr (ap->expr)) + return MATCH_ERROR; ! if (not_restricted == 0 ! && ap->expr->expr_type != EXPR_VARIABLE ! && !check_restricted (ap->expr)) ! return MATCH_ERROR; ! ! if (not_restricted == 0 ! && ap->expr->expr_type == EXPR_VARIABLE ! && asym->attr.dummy && asym->attr.optional) ! return MATCH_NO; } return MATCH_YES; *************** gfc_check_assign (gfc_expr *lvalue, gfc_ *** 3683,3689 **** gfc_error ("BOZ literal constant near %L cannot be assigned to a " "%qs variable", &rvalue->where, gfc_typename (&lvalue->ts)); ! return false; } --- 3694,3700 ---- gfc_error ("BOZ literal constant near %L cannot be assigned to a " "%qs variable", &rvalue->where, gfc_typename (&lvalue->ts)); ! return false; } Index: gcc/testsuite/gfortran.dg/associate_49.f90 =================================================================== *** gcc/testsuite/gfortran.dg/associate_49.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/associate_49.f90 (working copy) *************** *** 0 **** --- 1,34 ---- + ! { dg-do run } + ! + ! Test the fix for PR91588, in which the declaration of 'a' caused + ! an ICE. + ! + ! Contributed by Gerhardt Steinmetz + ! + program p + character(4), parameter :: parm = '7890' + associate (z => '1234') + block + integer(len(z)) :: a + if (kind(a) .ne. 4) stop 1 + end block + end associate + associate (z => '123') + block + integer(len(z)+1) :: a + if (kind(a) .ne. 4) stop 2 + end block + end associate + associate (z => 1_8) + block + integer(kind(z)) :: a + if (kind(a) .ne. 8) stop 3 + end block + end associate + associate (z => parm) + block + integer(len(z)) :: a + if (kind(a) .ne. 4) stop 4 + end block + end associate + end