From patchwork Mon Aug 1 15:41:16 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 107773 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 533A7B702E for ; Tue, 2 Aug 2011 01:41:47 +1000 (EST) Received: (qmail 5547 invoked by alias); 1 Aug 2011 15:41:42 -0000 Received: (qmail 5497 invoked by uid 22791); 1 Aug 2011 15:41:40 -0000 X-SWARE-Spam-Status: No, hits=-2.2 required=5.0 tests=AWL, BAYES_00, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (194.98.77.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 01 Aug 2011 15:41:26 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id E6F40CB025A; Mon, 1 Aug 2011 17:41:24 +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 p2IkDl-FhoQZ; Mon, 1 Aug 2011 17:41:14 +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 24FBDCB0286; Mon, 1 Aug 2011 17:41:14 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 113FE85978; Mon, 1 Aug 2011 17:41:16 +0200 (CEST) Date: Mon, 1 Aug 2011 17:41:16 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Conformance for quantified expressions Message-ID: <20110801154116.GA23435@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 Ada2012 Quantified expressions can appear in default expressions, and must be checked for conformance. The following compilation: gcc -c -gnat12 -gnata conf.adb must yield: conf.adb:16:14: not fully conformant with declaration at line 4 conf.adb:16:14: default expression for "X" does not match conf.adb:22:14: not fully conformant with declaration at line 6 conf.adb:22:14: default expression for "X" does not match conf.adb:29:14: not fully conformant with declaration at line 9 conf.adb:29:14: default expression for "X" does not match conf.adb:37:14: not fully conformant with declaration at line 12 conf.adb:37:14: default expression for "X" does not match --- procedure Conf is table : array (1..10) of integer := (others => 1); procedure Maybe (X : Boolean := (for all E of table => E = 1)); procedure Peut_Etre (X : Boolean := (for all I in table'range => Table (I) = 1)); procedure Quizas (X : Boolean := (for all I in table'range => Table (I) = 1)); procedure Qui_Sait (X : Boolean := (for all I of table => Table (I) = 1)); -- Expression doesn't match procedure Maybe (X : Boolean := (for all E of table => E = 2)) is begin null; end; -- loop parameter doesn't match procedure Peut_Etre (X : Boolean := (for all J in table'range => Table (J) = 1)) is begin null; end; -- discrete range doesn't match procedure Quizas (X : Boolean := (for all I in table'first .. table'last => Table (I) = 1)) is begin null; end; -- discrete range doesn't match procedure Qui_Sait (X : Boolean := (for all I in reverse table'range => Table (I) = 1)) is begin null; end; begin Table (5) := 0; Maybe; Qui_Sait; Quizas; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-01 Ed Schonberg * sem_ch6.adb (Fully_Conformant_Expressions): handle quantified expressions. Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 177048) +++ sem_ch6.adb (working copy) @@ -6685,6 +6685,50 @@ and then FCE (Expression (E1), Expression (E2)); + when N_Quantified_Expression => + if not FCE (Condition (E1), Condition (E2)) then + return False; + end if; + + if Present (Loop_Parameter_Specification (E1)) + and then Present (Loop_Parameter_Specification (E2)) + then + declare + L1 : constant Node_Id := + Loop_Parameter_Specification (E1); + L2 : constant Node_Id := + Loop_Parameter_Specification (E2); + + begin + return + Reverse_Present (L1) = Reverse_Present (L2) + and then + FCE (Defining_Identifier (L1), + Defining_Identifier (L2)) + and then + FCE (Discrete_Subtype_Definition (L1), + Discrete_Subtype_Definition (L2)); + end; + + else -- quantified expression with an iterator + declare + I1 : constant Node_Id := Iterator_Specification (E1); + I2 : constant Node_Id := Iterator_Specification (E2); + + begin + return + FCE (Defining_Identifier (I1), + Defining_Identifier (I2)) + and then + Of_Present (I1) = Of_Present (I2) + and then + Reverse_Present (I1) = Reverse_Present (I2) + and then FCE (Name (I1), Name (I2)) + and then FCE (Subtype_Indication (I1), + Subtype_Indication (I2)); + end; + end if; + when N_Range => return FCE (Low_Bound (E1), Low_Bound (E2))