From patchwork Wed Apr 20 10:29:34 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 612617 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.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3qqdRm2BpTz9s5l for ; Wed, 20 Apr 2016 20:29:56 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=FeTwbHCN; dkim-atps=neutral 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=GWDdg3F0G6cLO1zX+3Oqww9kBvt6g41upZpB1yuTd7tgSjBLwr ZtbgXKKMHVO7KWVWvkk9n7JtC2ou+NCDh1W8hKkku26ANntxMIzQkvXCZUOFJFyq Vnel1d12bGzeBneumkYYv3CfYoQxypKISqJJZZ8bn3OMQxDq65hWH6i7Q= 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=1Pf/W7ljxYS90fqRYnZeJfL8FYQ=; b=FeTwbHCNF70E12CCdW9T nrD2io+oXCMXWaT6jPcLdYg8tUOM/lKh2U8aYqR6TMbDbSzB3o0cRQgTTTnujcBH YfDUUQXAHUxr8FxynXjno8wTOfILFcS4SMcK7zpXjYqMQqt2Pyo1+Zp8srcXVREe 2x9C6N1dhx2rTqqZOuHcBPA= Received: (qmail 36817 invoked by alias); 20 Apr 2016 10:29:47 -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 36802 invoked by uid 89); 20 Apr 2016 10:29:46 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=2.6 required=5.0 tests=BAYES_50, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_NONE autolearn=no version=3.3.2 spammy=elsif, Nkind, nkind, Etype 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 (AES256-SHA encrypted) ESMTPS; Wed, 20 Apr 2016 10:29:36 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id DAEE5116B92; Wed, 20 Apr 2016 06:29:34 -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 Wh6kSS3YqPuT; Wed, 20 Apr 2016 06:29:34 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id CA485116B86; Wed, 20 Apr 2016 06:29:34 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id C68BE17F; Wed, 20 Apr 2016 06:29:34 -0400 (EDT) Date: Wed, 20 Apr 2016 06:29:34 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Constraint_Error on spurious ambiguity in instance Message-ID: <20160420102934.GA129463@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch updates the instantiation machinery to properly preserve a reference to a global type in a qualified expression used to convert a universal literal to a specific type, and propagate it to the instantiated template. ------------ -- Source -- ------------ -- types.ads package Types is type Uint is private; type Int is range -2**31 .. +2**31 - 1; function "+" (Left : Uint; Right : Uint) return Uint; function "+" (Left : Int; Right : Uint) return Uint; function "+" (Left : Uint; Right : Int) return Uint; function "*" (Left : Uint; Right : Uint) return Uint; function "*" (Left : Int; Right : Uint) return Uint; function "*" (Left : Uint; Right : Int) return Uint; private Uint_Low_Bound : constant := 600_000_000; Uint_High_Bound : constant := 2_099_999_999; type Uint is new Int range Uint_Low_Bound .. Uint_High_Bound; No_Uint : constant Uint := Uint (Uint_Low_Bound); end Types; -- types.adb package body Types is function "+" (Left : Uint; Right : Uint) return Uint is begin return No_Uint; end "+"; function "+" (Left : Int; Right : Uint) return Uint is begin return No_Uint; end "+"; function "+" (Left : Uint; Right : Int) return Uint is begin return No_Uint; end "+"; function "*" (Left : Uint; Right : Uint) return Uint is begin return No_Uint; end "+"; function "*" (Left : Int; Right : Uint) return Uint is begin return No_Uint; end "+"; function "*" (Left : Uint; Right : Int) return Uint is begin return No_Uint; end "+"; end Types; -- types_gen.ads generic package Types_Gen is procedure Compute; end Types_Gen; -- types_gen.adb with Types; use Types; package body Types_Gen is procedure Compute is UI_Int_Value : Uint; begin UI_Int_Value := UI_Int_Value * 10 + 20; end Compute; end Types_Gen; -- types_inst.ads with Types_Gen; package Types_Inst is new Types_Gen; ----------------- -- Compilation -- ----------------- $ gcc -c -gnatct types_inst.ads Tested on x86_64-pc-linux-gnu, committed on trunk 2016-04-20 Hristian Kirtchev * sem_ch12.adb (Copy_Generic_Node): Handle the special qualification installed for universal literals that act as operands in binary or unary operators. (Qualify_Operand): Mark the qualification to signal the instantiation mechanism how to handle global reference propagation. * sinfo.adb (Is_Qualified_Universal_Literal): New routine. (Set_Is_Qualified_Universal_Literal): New routine. * sinfo.ads New attribute Is_Qualified_Universal_Literal along with occurrences in nodes. (Is_Qualified_Universal_Literal): New routine along with pragma Inline. (Set_Is_Qualified_Universal_Literal): New routine along with pragma Inline. Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 235254) +++ sem_ch12.adb (working copy) @@ -7293,6 +7293,20 @@ Set_Entity (New_N, Entity (Assoc)); Check_Private_View (N); + -- The node is a reference to a global type and acts as the + -- subtype mark of a qualified expression created in order + -- to aid resolution of accidental overloading in instances. + -- Since N is a reference to a type, the Associated_Node of + -- N denotes an entity rather than another identifier. See + -- Qualify_Universal_Operands for details. + + elsif Nkind (N) = N_Identifier + and then Nkind (Parent (N)) = N_Qualified_Expression + and then Subtype_Mark (Parent (N)) = N + and then Is_Qualified_Universal_Literal (Parent (N)) + then + Set_Entity (New_N, Assoc); + -- The name in the call may be a selected component if the -- call has not been analyzed yet, as may be the case for -- pre/post conditions in a generic unit. @@ -13982,6 +13996,7 @@ Loc : constant Source_Ptr := Sloc (Opnd); Typ : constant Entity_Id := Etype (Actual); Mark : Node_Id; + Qual : Node_Id; begin -- Qualify the operand when it is of a universal type. Note that @@ -14007,10 +14022,19 @@ Mark := Qualify_Type (Loc, Typ); end if; - Rewrite (Opnd, + Qual := Make_Qualified_Expression (Loc, Subtype_Mark => Mark, - Expression => Relocate_Node (Opnd))); + Expression => Relocate_Node (Opnd)); + + -- Mark the qualification to distinguish it from other source + -- constructs and signal the instantiation mechanism that this + -- node requires special processing. See Copy_Generic_Node for + -- details. + + Set_Is_Qualified_Universal_Literal (Qual); + + Rewrite (Opnd, Qual); end if; end Qualify_Operand; Index: sinfo.adb =================================================================== --- sinfo.adb (revision 235243) +++ sinfo.adb (working copy) @@ -1982,6 +1982,14 @@ return Flag7 (N); end Is_Protected_Subprogram_Body; + function Is_Qualified_Universal_Literal + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Qualified_Expression); + return Flag4 (N); + end Is_Qualified_Universal_Literal; + function Is_Static_Coextension (N : Node_Id) return Boolean is begin @@ -5229,6 +5237,14 @@ Set_Flag7 (N, Val); end Set_Is_Protected_Subprogram_Body; + procedure Set_Is_Qualified_Universal_Literal + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Qualified_Expression); + Set_Flag4 (N, Val); + end Set_Is_Qualified_Universal_Literal; + procedure Set_Is_Static_Coextension (N : Node_Id; Val : Boolean := True) is begin Index: sinfo.ads =================================================================== --- sinfo.ads (revision 235247) +++ sinfo.ads (working copy) @@ -1710,6 +1710,12 @@ -- handler to make sure that the associated protected object is unlocked -- when the subprogram completes. + -- Is_Qualified_Universal_Literal (Flag4-Sem) + -- Present in N_Qualified_Expression nodes. Set when the qualification is + -- converting a universal literal to a specific type. Such qualifiers aid + -- the resolution of accidental overloading of binary or unary operators + -- which may occur in instances. + -- Is_Static_Coextension (Flag14-Sem) -- Present in N_Allocator nodes. Set if the allocator is a coextension -- of an object allocated on the stack rather than the heap. @@ -4542,6 +4548,7 @@ -- Subtype_Mark (Node4) -- Expression (Node3) expression or aggregate -- plus fields for expression + -- Is_Qualified_Universal_Literal (Flag4-Sem) -------------------- -- 4.8 Allocator -- @@ -9399,6 +9406,9 @@ function Is_Protected_Subprogram_Body (N : Node_Id) return Boolean; -- Flag7 + function Is_Qualified_Universal_Literal + (N : Node_Id) return Boolean; -- Flag4 + function Is_Static_Coextension (N : Node_Id) return Boolean; -- Flag14 @@ -10437,6 +10447,9 @@ procedure Set_Is_Protected_Subprogram_Body (N : Node_Id; Val : Boolean := True); -- Flag7 + procedure Set_Is_Qualified_Universal_Literal + (N : Node_Id; Val : Boolean := True); -- Flag4 + procedure Set_Is_Static_Coextension (N : Node_Id; Val : Boolean := True); -- Flag14 @@ -12819,6 +12832,7 @@ pragma Inline (Is_Power_Of_2_For_Shift); pragma Inline (Is_Prefixed_Call); pragma Inline (Is_Protected_Subprogram_Body); + pragma Inline (Is_Qualified_Universal_Literal); pragma Inline (Is_Static_Coextension); pragma Inline (Is_Static_Expression); pragma Inline (Is_Subprogram_Descriptor); @@ -13160,6 +13174,7 @@ pragma Inline (Set_Is_Power_Of_2_For_Shift); pragma Inline (Set_Is_Prefixed_Call); pragma Inline (Set_Is_Protected_Subprogram_Body); + pragma Inline (Set_Is_Qualified_Universal_Literal); pragma Inline (Set_Is_Static_Coextension); pragma Inline (Set_Is_Static_Expression); pragma Inline (Set_Is_Subprogram_Descriptor);