From patchwork Mon Jul 23 08:13:23 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 172572 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 0254D2C00EB for ; Mon, 23 Jul 2012 18:14:17 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1343636058; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=aQGqLzL4G8AVD1fjij79 BJvQFVY=; b=Vz87j+bIR3Gup7KVI4tX9OTpElbjPZnhxwGEzy+mx0GnVaDkoRJ8 dNkIAN5AsELIdh09R3q7jv8YLKU+C7mKUUQHRal25zXqCQElMnH/kNvb9OaKmIh+ pRu0rXLUNSGAN3e32oHQjC3g5toeqFZ0Ut5Jb+XsL1uL9LbugvnQWuk= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=AIIUtya/nAhJFBdYcuQox0YGPvk11X77Y23PHEgQ1naJ1Pspoi0i0+u4wRYWrV +rXxWPA397oAvKyuvIu9rqX/zGQ5XwcHLeTnmoCSiPKIX/EV+rSUkwlJPUjlJgmy 7Ux81CLPJbrQR1NgtkdRQBs9s4Vbf76MykuNdhaBYOJac=; Received: (qmail 28116 invoked by alias); 23 Jul 2012 08:13:52 -0000 Received: (qmail 27850 invoked by uid 22791); 23 Jul 2012 08:13:44 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 23 Jul 2012 08:13:25 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id A99821C7539; Mon, 23 Jul 2012 04:13:23 -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 Xcdb+XcWSrmB; Mon, 23 Jul 2012 04:13:23 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 8AFC21C6EBD; Mon, 23 Jul 2012 04:13:23 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 8972F92BF6; Mon, 23 Jul 2012 04:13:23 -0400 (EDT) Date: Mon, 23 Jul 2012 04:13:23 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Vincent Pucci Subject: [Ada] Improve GNAT dimensionality checking system Message-ID: <20120723081323.GA5270@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) 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 For GNAT dimensionality checking system, accept constant declaration whose type is a dimensioned type when an initialization expression with dimension is present. The test presented below highlights this new patch: ------------ -- Source -- ------------ with System.Dim.Mks_IO; use System.Dim.Mks_IO; with System.Dim.Mks; use System.Dim.Mks; procedure Main is My_Cons : constant Mks_Type := cm * g**2; begin Put_Dim_Of (My_Cons); end Main; ------------------------------- -- Compilation and Execution -- ------------------------------- $ gnatmake -q -gnat12 main.adb $ ./main ------------ -- Output -- ------------ [L.M**2] Tested on x86_64-pc-linux-gnu, committed on trunk 2012-07-23 Vincent Pucci * sem_dim.adb (Analyze_Dimension_Has_Etype): For identifier, propagate dimension when entity is a non-dimensionless constant. (Analyze_Dimension_Object_Declaration): Propagate dimension from the expression to the entity when type is a dimensioned type and object is a constant. Index: sem_dim.adb =================================================================== --- sem_dim.adb (revision 189768) +++ sem_dim.adb (working copy) @@ -1617,6 +1617,14 @@ if Exists (Dims_Of_Etyp) then Set_Dimensions (N, Dims_Of_Etyp); + + -- Propagation of the dimensions from the entity for identifier whose + -- entity is a non-dimensionless consant. + + elsif Nkind (N) = N_Identifier + and then Exists (Dimensions_Of (Entity (N))) + then + Set_Dimensions (N, Dimensions_Of (Entity (N))); end if; -- Removal of dimensions in expression @@ -1692,7 +1700,7 @@ if Present (Expr) then Dim_Of_Expr := Dimensions_Of (Expr); - -- case when expression is not a literal and when dimensions of the + -- Case when expression is not a literal and when dimensions of the -- expression and of the type mismatch if not Nkind_In (Original_Node (Expr), @@ -1700,7 +1708,20 @@ N_Integer_Literal) and then Dim_Of_Expr /= Dim_Of_Etyp then - Error_Dim_Msg_For_Object_Declaration (N, Etyp, Expr); + -- Propagate the dimension from the expression to the object + -- entity when the object is a constant whose type is a + -- dimensioned type. + + if Constant_Present (N) + and then not Exists (Dim_Of_Etyp) + then + Set_Dimensions (Id, Dim_Of_Expr); + + -- Otherwise, issue an error message + + else + Error_Dim_Msg_For_Object_Declaration (N, Etyp, Expr); + end if; end if; -- Removal of dimensions in expression