From patchwork Tue Apr 23 14:57:47 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 238937 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 B75C82C0102 for ; Wed, 24 Apr 2013 00:57:56 +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=doOKa0KGdL0RXFNFlx6Tet0a96KlZu/OnpRb5hikxal358uZAf Gszt5CW3JCafrAWi08MFC+st9LhvHPoxd8WH21MyExFXmK4YctXRQ7+Ak+BK/TZ/ eBEtoOR0MuDXUxiyjHMsaBmEgWNeyzvNZmR8IasgBCjiKO/NvHm0XMhO0= 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=0gN4O/qosEqntSe5tE265xgCa7I=; b=XWdqim4JnH4DLYjeXChi Vy0066WbsVrObT7TI22aLMFygBn/QQYBzQwgIn2To1y3lNnIy7xs0Z5DP/sUXGmM bqC1DgUmdZru92954i2UGBMJysbkv+eCtLOQ9RV6DDvFcx0BqaVyavSCTxaTEGbB NzkfLaydSQthfY1y1vyKFOk= Received: (qmail 11926 invoked by alias); 23 Apr 2013 14:57:50 -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 11912 invoked by uid 89); 23 Apr 2013 14:57:49 -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; Tue, 23 Apr 2013 14:57:49 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 4B87C2E749; Tue, 23 Apr 2013 10:57:47 -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 UiV8FE8vYxJf; Tue, 23 Apr 2013 10:57:47 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 2B7922E1CD; Tue, 23 Apr 2013 10:57:47 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 210173FF09; Tue, 23 Apr 2013 10:57:47 -0400 (EDT) Date: Tue, 23 Apr 2013 10:57:47 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Yannick Moy Subject: [Ada] Reject illegal uses of Static_Predicate Message-ID: <20130423145747.GA9591@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) X-Virus-Found: No Static_Predicate should not be applied on non-scalar types. The example below is now rejected by GNAT: $ gcc -c -gnat12 t.ads 1. package T is 2. type R is tagged record | >>> static predicate not allowed for non-scalar type "R" 3. A, B : Integer; 4. end record with Static_Predicate => R.A = 0 and R.B = 0; 5. end T; Tested on x86_64-pc-linux-gnu, committed on trunk 2013-04-23 Yannick Moy * einfo.ads: Minor typo fix. * sem_ch13.adb (Build_Predicate_Functions): Reject cases where Static_Predicate is applied to a non-scalar or non-static type. * sem_prag.adb: Minor typo fix. Index: einfo.ads =================================================================== --- einfo.ads (revision 198194) +++ einfo.ads (working copy) @@ -2544,7 +2544,7 @@ -- entirely synthesized, by looking at the bounds, and the immediate -- subtype parent. However, this method does not work for some Itypes -- that have no parent set (and the only way to find the immediate --- subtype parent is to go through the tree). For now, this flay is set +-- subtype parent is to go through the tree). For now, this flag is set -- conservatively, i.e. if it is set then for sure the subtype is non- -- static, but if it is not set, then the type may or may not be static. -- Thus the test for a static subtype is that this flag is clear AND that Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 198195) +++ sem_prag.adb (working copy) @@ -8121,8 +8121,8 @@ -- Set Check_On to indicate check status -- If this comes from an aspect, we have already taken care of - -- the policy active when the aspect was analyzed, and Is_Ignore - -- is set appriately already. + -- the policy active when the aspect was analyzed, and Is_Ignored + -- is set appropriately already. if From_Aspect_Specification (N) then Check_On := not Is_Ignored (N); Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 198184) +++ sem_ch13.adb (working copy) @@ -980,7 +980,7 @@ -- Perform analysis of the External_Name or Link_Name aspects procedure Analyze_Aspect_Implicit_Dereference; - -- Perform analysis of the Implicit_Dereference aspects + -- Perform analysis of the Implicit_Dereference aspects procedure Make_Aitem_Pragma (Pragma_Argument_Associations : List_Id; @@ -1082,8 +1082,8 @@ Pragma_Argument_Associations, Pragma_Identifier => Make_Identifier (Sloc (Id), Pragma_Name), - Class_Present => Class_Present (Aspect), - Split_PPC => Split_PPC (Aspect)); + Class_Present => Class_Present (Aspect), + Split_PPC => Split_PPC (Aspect)); -- Set additional semantic fields @@ -5707,7 +5707,7 @@ -- Build_Predicate_Functions -- ------------------------------- - -- The procedures that are constructed here has the form: + -- The procedures that are constructed here have the form: -- function typPredicate (Ixxx : typ) return Boolean is -- begin @@ -5725,8 +5725,8 @@ -- use this function even if checks are off, e.g. for membership tests. -- If the expression has at least one Raise_Expression, then we also build - -- the typPredicateM version of the function, in which any occurence of a - -- Raise_Expressioon is converted to "return False". + -- the typPredicateM version of the function, in which any occurrence of a + -- Raise_Expression is converted to "return False". procedure Build_Predicate_Functions (Typ : Entity_Id; N : Node_Id) is Loc : constant Source_Ptr := Sloc (Typ); @@ -6216,23 +6216,49 @@ -- Deal with static predicate case - if Ekind_In (Typ, E_Enumeration_Subtype, - E_Modular_Integer_Subtype, - E_Signed_Integer_Subtype) + -- ??? We don't currently deal with real types + -- ??? Why requiring that Typ is static? + + if Ekind (Typ) in Discrete_Kind and then Is_Static_Subtype (Typ) and then not Dynamic_Predicate_Present then - Build_Static_Predicate (Typ, Expr, Object_Name); + -- Only build the predicate for subtypes - if Present (Static_Predicate_Present) - and No (Static_Predicate (Typ)) + if Ekind_In (Typ, E_Enumeration_Subtype, + E_Modular_Integer_Subtype, + E_Signed_Integer_Subtype) then - Error_Msg_F - ("expression does not have required form for " - & "static predicate", - Next (First (Pragma_Argument_Associations - (Static_Predicate_Present)))); + Build_Static_Predicate (Typ, Expr, Object_Name); + + if Present (Static_Predicate_Present) + and No (Static_Predicate (Typ)) + then + Error_Msg_F + ("expression does not have required form for " + & "static predicate", + Next (First (Pragma_Argument_Associations + (Static_Predicate_Present)))); + end if; end if; + + -- 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 + -- would be duplicates of the same error on a source type. + + elsif Present (Static_Predicate_Present) + and then Comes_From_Source (Typ) + then + if Is_Scalar_Type (Typ) then + Error_Msg_FE + ("static predicate not allowed for non-static type&", + Typ, Typ); + else + Error_Msg_FE + ("static predicate not allowed for non-scalar type&", + Typ, Typ); + end if; end if; end if; end Build_Predicate_Functions;