From patchwork Mon May 28 08:59:21 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 921377 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-478604-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="MPHqqyLo"; 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 40vW5R5Fxkz9s0q for ; Mon, 28 May 2018 18:59:55 +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:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=u4wvkR25xaPoefwFavbzyj4PLxLSsfioeZB2btAIfqVmGeWTOB BZYGNSpLa3l4PoSbW5MllRXVBiFRrcCOfdqxNM0bMjQkbWsBYqG1p4MB9FoqFC+z JUj65XarBP6P7NCeaIqVw14KFsriSEziXOF85SJ7wXjwIRZJ8siI78gs8= 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:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=caweVPcOr4TuamtrMkDMsvK/lsg=; b=MPHqqyLoPO4uV+JYHU04 tBFSGzSN2ME0ZM9/GlZBj6rPs2v1mlABzVIme5nZ2dbm+VyrhqCrJegkBN1p3T/9 QG7D8x3cypLPTdueiYG3uWWxMhlVqkSmKa07bOUJR4Y4MZ/goa7T3nWQWQYflPGw Fxx5dN7ovbr351gI1nP07Qg= Received: (qmail 69629 invoked by alias); 28 May 2018 08:59:25 -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 69527 invoked by uid 89); 28 May 2018 08:59:24 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy= X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 28 May 2018 08:59:22 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 2E4DF117DA5; Mon, 28 May 2018 04:59:21 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id ZPV0hyHJQpy7; Mon, 28 May 2018 04:59:21 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 1DC23117DA1; Mon, 28 May 2018 04:59:21 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 1CB934EF; Mon, 28 May 2018 04:59:21 -0400 (EDT) Date: Mon, 28 May 2018 04:59:21 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix internal error on renaming of equality for record type Message-ID: <20180528085921.GA68430@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This adjusts the previous change to the cases where the array type is not yet frozen and, therefore, where Size_Depends_On_Discriminant is not yet computed, by doing the computation manually. Tested on x86_64-pc-linux-gnu, committed on trunk 2018-05-28 Eric Botcazou gcc/ada/ * exp_ch4.adb (Expand_Composite_Equality): Compute whether the size depends on a discriminant manually instead of using the predicate Size_Depends_On_Discriminant in the array type case. gcc/testsuite/ * gnat.dg/renaming12.adb, gnat.dg/renaming12.ads: New testcase. --- gcc/ada/exp_ch4.adb +++ gcc/ada/exp_ch4.adb @@ -2435,6 +2435,10 @@ package body Exp_Ch4 is else declare Comp_Typ : Entity_Id; + Indx : Node_Id; + Ityp : Entity_Id; + Lo : Node_Id; + Hi : Node_Id; begin -- Do the comparison in the type (or its full view) and not in @@ -2450,9 +2454,25 @@ package body Exp_Ch4 is -- Except for the case where the bounds of the type depend on a -- discriminant, or else we would run into scoping issues. - if Size_Depends_On_Discriminant (Comp_Typ) then - Comp_Typ := Full_Type; - end if; + Indx := First_Index (Comp_Typ); + while Present (Indx) loop + Ityp := Etype (Indx); + + Lo := Type_Low_Bound (Ityp); + Hi := Type_High_Bound (Ityp); + + if (Nkind (Lo) = N_Identifier + and then Ekind (Entity (Lo)) = E_Discriminant) + or else + (Nkind (Hi) = N_Identifier + and then Ekind (Entity (Hi)) = E_Discriminant) + then + Comp_Typ := Full_Type; + exit; + end if; + + Next_Index (Indx); + end loop; return Expand_Array_Equality (Nod, Lhs, Rhs, Bodies, Comp_Typ); end; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/renaming12.adb @@ -0,0 +1,7 @@ +-- { dg-do compile } + +package body Renaming12 is + + procedure Dummy is null; + +end Renaming12; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/renaming12.ads @@ -0,0 +1,23 @@ +package Renaming12 is + + type Index_Type is range 0 .. 40; + + type Rec1 is record + B : Boolean; + end record; + + type Arr is array (Index_Type range <>) of Rec1; + + type Rec2 (Count : Index_Type := 0) is record + A : Arr (1 .. Count); + end record; + + package Ops is + + function "=" (L : Rec2; R : Rec2) return Boolean renames Renaming12."="; + + end Ops; + + procedure Dummy; + +end Renaming12;