From patchwork Wed Jun 23 06:26:44 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56593 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 69C87B6F11 for ; Wed, 23 Jun 2010 16:26:59 +1000 (EST) Received: (qmail 28902 invoked by alias); 23 Jun 2010 06:26:57 -0000 Received: (qmail 28893 invoked by uid 22791); 23 Jun 2010 06:26:55 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 23 Jun 2010 06:26:42 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 3D817CB027F; Wed, 23 Jun 2010 08:26:45 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id AiGHkA4RC7BD; Wed, 23 Jun 2010 08:26:45 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 219DFCB01D4; Wed, 23 Jun 2010 08:26:45 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 17C9ED9AB0; Wed, 23 Jun 2010 08:26:44 +0200 (CEST) Date: Wed, 23 Jun 2010 08:26:44 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Attributes of arrays with an index type derived from a formal type Message-ID: <20100623062644.GA29656@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes 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 The attributes of formal discrete types, and of arrays whose indices are formal types, are not static and cannot be constant-folded. The same is true if an index type is derived from a formal type. The check for types derived from formal types was missing, leading to improper static evaluation.. The following must compile and execute quietly: with G1; procedure Q is type Indx is range 1 .. 10; package Inst is new G1 (Indx); use Inst; Obj : R := ((others => 0), 10); begin if not Is_Full (Obj) then raise Program_Error; end if; end; --- generic type Ix is range <>; package G1 is type Iterator is new Ix; type Arr is array (Iterator) of integer; type R is record Nodes : Arr; Count : Positive; end record; function Is_Full (It : R) return Boolean; end G1; --- package body G1 is function Is_Full (It : R) return Boolean is begin return It.Count = It.Nodes'Length; end Is_Full; end G1; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-23 Ed Schonberg * sem_attr.adb (Eval_Attribute): If the prefix is an array, the attribute cannot be constant-folded if an index type is a formal type, or is derived from one. * checks.adb (Determine_Range): ditto. Index: checks.adb =================================================================== --- checks.adb (revision 161078) +++ checks.adb (working copy) @@ -3351,6 +3351,14 @@ package body Checks is Indx := Next_Index (Indx); end loop; + -- if The index type is a formal type, or derived from + -- one, the bounds are not static. + + if Is_Generic_Type (Root_Type (Etype (Indx))) then + OK := False; + return; + end if; + Determine_Range (Type_Low_Bound (Etype (Indx)), OK1, LL, LU, Assume_Valid); Index: sem_attr.adb =================================================================== --- sem_attr.adb (revision 161200) +++ sem_attr.adb (working copy) @@ -5633,10 +5633,10 @@ package body Sem_Attr is while Present (N) loop Static := Static and then Is_Static_Subtype (Etype (N)); - -- If however the index type is generic, attributes cannot - -- be folded. + -- If however the index type is generic, or derived from + -- one, attributes cannot be folded. - if Is_Generic_Type (Etype (N)) + if Is_Generic_Type (Root_Type (Etype (N))) and then Id /= Attribute_Component_Size then return; @@ -6205,13 +6205,13 @@ package body Sem_Attr is Ind : Node_Id; begin - -- In the case of a generic index type, the bounds may appear static - -- but the computation is not meaningful in this case, and may - -- generate a spurious warning. + -- If any index type is a formal type, or derived from one, the + -- bounds are not static. Treating them as static can produce + -- spurious warnings or improper constant folding. Ind := First_Index (P_Type); while Present (Ind) loop - if Is_Generic_Type (Etype (Ind)) then + if Is_Generic_Type (Root_Type (Etype (Ind))) then return; end if;