From patchwork Thu Apr 25 10:13:29 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 239454 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]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 374C62C00C8 for ; Thu, 25 Apr 2013 20:13:43 +1000 (EST) 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=RHr3mjL+9bYTlJoI0NKB773AnPMhpIZaHXkvr7bgiRol+BW+2K Q1lqL55ZUMpvMEy6N1Og82y/qjXK3PD28ohpYUom03SAMLxBF5GTVg+ciRzHusr7 FxfEhIUeK7o7Gy/HsLsa3U7LsltocsHj3CtioEmxaP9pjgICDdwTjW/8s= 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=tcNOGHFI26ybqhvh6wjmYNymTiU=; b=HwD6T7t8wIwkkPgvHX73 dKb5zInWPraHdiQZm9j2V0Gv31640eNgdLkSHkC1ehAeHVV0dnzAUildJJjTL/VK c2l5PXqdeNJO4Roimn5p4PhoNkMdHCxiertjCVJFMuc5bKIruEhKBEhjYwSWIAYQ YgytGh210QVw38IRZldaF5s= Received: (qmail 9430 invoked by alias); 25 Apr 2013 10:13:32 -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 9378 invoked by uid 89); 25 Apr 2013 10:13:31 -0000 X-Spam-SWARE-Status: No, score=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO autolearn=ham version=3.3.1 Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Thu, 25 Apr 2013 10:13:31 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 987381C778E; Thu, 25 Apr 2013 06:13:29 -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 uXQQZcMYYV+m; Thu, 25 Apr 2013 06:13:29 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 633181C7C31; Thu, 25 Apr 2013 06:13:29 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 625553FF09; Thu, 25 Apr 2013 06:13:29 -0400 (EDT) Date: Thu, 25 Apr 2013 06:13:29 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Expression of static predicate should be static Message-ID: <20130425101329.GA1200@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) X-Virus-Found: No This patch updates the mechanism which creates predicate functions to ensure that the expression of a static predicate is static. ------------ -- Source -- ------------ -- pack.ads package Pack is subtype T1 is Integer with Dynamic_Predicate => T1 /= 0; subtype T2 is T1 with Static_Predicate => T2 mod 2 = 0; end Pack; ---------------------------- -- Compilation and output -- ---------------------------- $ gcc -c -gnat12 pack.ads pack.ads:3:55: expression does not have required form for static predicate Tested on x86_64-pc-linux-gnu, committed on trunk 2013-04-25 Hristian Kirtchev * sem_ch13.adb (Add_Call): Do not capture the nature of the inherited predicate. (Add_Predicates): Save the static predicate for diagnostics and error reporting purposes. (Process_PPCs): Remove local variables Dynamic_Predicate_Present and Static_Predicate_Present. Add local variable Static_Pred. Ensure that the expression of a static predicate is static. Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 198243) +++ sem_ch13.adb (working copy) @@ -5741,6 +5741,9 @@ Raise_Expression_Present : Boolean := False; -- Set True if Expr has at least one Raise_Expression + Static_Predic : Node_Id := Empty; + -- Set to N_Pragma node for a static predicate if one is encountered + procedure Add_Call (T : Entity_Id); -- Includes a call to the predicate function for type T in Expr if T -- has predicates and Predicate_Function (T) is non-empty. @@ -5765,13 +5768,6 @@ procedure Process_REs is new Traverse_Proc (Process_RE); -- Marks any raise expressions in Expr_M to return False - Dynamic_Predicate_Present : Boolean := False; - -- Set True if a dynamic predicate is present, results in the entire - -- predicate being considered dynamic even if it looks static. - - Static_Predicate_Present : Node_Id := Empty; - -- Set to N_Pragma node for a static predicate if one is encountered - -------------- -- Add_Call -- -------------- @@ -5783,12 +5779,6 @@ if Present (T) and then Present (Predicate_Function (T)) then Set_Has_Predicates (Typ); - -- Capture the nature of the inherited ancestor predicate - - if Has_Dynamic_Predicate_Aspect (T) then - Dynamic_Predicate_Present := True; - end if; - -- Build the call to the predicate function of T Exp := @@ -5872,17 +5862,14 @@ if Nkind (Ritem) = N_Pragma and then Pragma_Name (Ritem) = Name_Predicate then - -- Capture the nature of the predicate + -- Save the static predicate of the type for diagnostics and + -- error reporting purposes. - if Present (Corresponding_Aspect (Ritem)) then - case Chars (Identifier (Corresponding_Aspect (Ritem))) is - when Name_Dynamic_Predicate => - Dynamic_Predicate_Present := True; - when Name_Static_Predicate => - Static_Predicate_Present := Ritem; - when others => - null; - end case; + if Present (Corresponding_Aspect (Ritem)) + and then Chars (Identifier (Corresponding_Aspect (Ritem))) = + Name_Static_Predicate + then + Static_Predic := Ritem; end if; -- Acquire arguments @@ -6211,7 +6198,9 @@ -- Attempt to build a static predicate for a discrete or a real -- subtype. This action may fail because the actual expression may - -- not be static. + -- not be static. Note that the presence of an inherited or + -- explicitly declared dynamic predicate is orthogonal to this + -- check because we are only interested in the static predicate. if Ekind_In (Typ, E_Decimal_Fixed_Point_Subtype, E_Enumeration_Subtype, @@ -6222,30 +6211,26 @@ then Build_Static_Predicate (Typ, Expr, Object_Name); - -- The predicate is categorized as static but its expression is - -- dynamic. Note that the predicate may become non-static when - -- inherited dynamic predicates are involved. + -- Emit an error when the predicate is categorized as static + -- but its expression is dynamic. - if Present (Static_Predicate_Present) + if Present (Static_Predic) and then No (Static_Predicate (Typ)) - and then not Dynamic_Predicate_Present then Error_Msg_F ("expression does not have required form for " & "static predicate", Next (First (Pragma_Argument_Associations - (Static_Predicate_Present)))); + (Static_Predic)))); end if; end if; - -- If a Static_Predicate applies on other types, that's an error: + -- If a static predicate applies on other types, that's an error: -- either the type is scalar but non-static, or it's not even a -- scalar type. We do not issue an error on generated types, as -- these may be duplicates of the same error on a source type. - elsif Present (Static_Predicate_Present) - and then Comes_From_Source (Typ) - then + elsif Present (Static_Predic) and then Comes_From_Source (Typ) then if Is_Scalar_Type (Typ) then Error_Msg_FE ("static predicate not allowed for non-static type&",