From patchwork Thu Sep 7 09:34:04 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 810941 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-461670-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="NeVhZ8Vt"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3xnwKS11jnz9sNV for ; Thu, 7 Sep 2017 19:35:07 +1000 (AEST) 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=G3VhlmnTa1h3fPD2gUu1V/y9CQ9uEAZdn9LFjQWidQsruHsnKC YkY8//7/eiyIspQblUo/cn69BNmlQWfhf/onaEjfpkrkA/xw+dbe5I34sOuOOcz3 D1cRgGOxJyDdsr99+PCCKgbrEAUnaMzZdqERb2fbdY0SJZntpWSCh9REY= 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=qIDIm1HFczoRTWjsUHmhrHSpQMI=; b=NeVhZ8Vt3p0B0agyYWYw JMqEVG1t1ZOEwpRcmTeojT0SY60gMJplhZxsYRyPvl+Iq7gBVWctNYz4QKnaSvSP YIrcXjn5AiMsIrZWcdVgXzxwoYyjJQQ3LoEcSYqBCJIxp5SY4M8JveqVRdVwjsFj 1BsNnVqhtamEK1oC4HBwD9c= Received: (qmail 94604 invoked by alias); 7 Sep 2017 09:34:11 -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 94371 invoked by uid 89); 7 Sep 2017 09:34:11 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.4 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=xn, 87006 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 07 Sep 2017 09:34:06 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id B30E8561A2; Thu, 7 Sep 2017 05:34:04 -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 ffDe0X+i2jIa; Thu, 7 Sep 2017 05:34:04 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 9C145561B2; Thu, 7 Sep 2017 05:34:04 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 9A1294FC; Thu, 7 Sep 2017 05:34:04 -0400 (EDT) Date: Thu, 7 Sep 2017 05:34:04 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Spurious errors on dynamic predicates and private declarations. Message-ID: <20170907093404.GA75110@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch fixes spurious visibility errors on the expression for a dynamic predicate in a subtype declaration, when the enclosing package includes private declarations. The following packages much compile quietly: --- package foo is type Kind_Type is (None, Known); type Auction_State_Type (Kind : Kind_Type) is record case Kind is when None => null; when Known => Bar : Integer; end case; end record; Null_Auction_State : constant Auction_State_Type; subtype Not_Null_Auction_State_Type is Auction_State_Type with Dynamic_Predicate => Not_Null_Auction_State_Type /= Auction_State_Type'(Kind => None); private Null_Auction_State : constant Auction_State_Type := (Kind => None); hing : Integer := 13; end foo; --- package TD is type T (N : Natural) is private; function Is_Null (X : T) return Boolean; subtype Not_Null_T is T with Dynamic_Predicate => not Is_Null (Not_Null_T); private type T (N : Natural) is null record; function Is_Null (X : T) return Boolean is (X.N = 0); end; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-07 Ed Schonberg * sem_ch6.adb (setr_Actual_Subtypes): Within a predicate function do not create actual subtypes that may generate further predicate functions. * sem_ch13.adb (Build_Predicate_Functions): Indicate that entity of body is a predicate function as well. (Resolve_Aspect_Expressions, Resolve_Name): For a component association, only the expression needs resolution, not the name. (Resolve_Aspect_Expressions, case Predicates): Construct and analyze the predicate function declaration in the scope of the type, before making the type and its discriminants visible. Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 251772) +++ sem_ch6.adb (working copy) @@ -11588,6 +11588,12 @@ if Ekind (Subp) = E_Procedure and then Is_Null_Init_Proc (Subp) then return; + + -- Within a predicate function we do not want to generate local + -- subtypes that may generate nested predicate functions. + + elsif Is_Subprogram (Subp) and then Is_Predicate_Function (Subp) then + return; end if; -- The subtype declarations may freeze the formals. The body generated Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 251786) +++ sem_ch13.adb (working copy) @@ -8700,6 +8700,9 @@ FBody : Node_Id; begin + Set_Ekind (SIdB, E_Function); + Set_Is_Predicate_Function (SIdB); + -- The predicate function is shared between views of a type if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then @@ -12664,6 +12667,7 @@ ------------------ function Resolve_Name (N : Node_Id) return Traverse_Result is + Dummy : Traverse_Result; begin if Nkind (N) = N_Selected_Component then if Nkind (Prefix (N)) = N_Identifier @@ -12681,6 +12685,12 @@ Set_Entity (N, Empty); end if; + -- The name is component association needs no resolution. + + elsif Nkind (N) = N_Component_Association then + Dummy := Resolve_Name (Expression (N)); + return Skip; + elsif Nkind (N) = N_Quantified_Expression then return Skip; end if; @@ -12722,14 +12732,19 @@ | Aspect_Static_Predicate => -- Build predicate function specification and preanalyze - -- expression after type replacement. + -- expression after type replacement. The function + -- declaration must be analyzed in the scope of the + -- type, but the expression must see components. if No (Predicate_Function (E)) then + Uninstall_Discriminants_And_Pop_Scope (E); declare FDecl : constant Node_Id := Build_Predicate_Function_Declaration (E); pragma Unreferenced (FDecl); + begin + Push_Scope_And_Install_Discriminants (E); Resolve_Aspect_Expression (Expr); end; end if;