From patchwork Thu Feb 20 14:05:02 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 322204 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 617A32C00C7 for ; Fri, 21 Feb 2014 01:05:16 +1100 (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=HJTpJQjwUarAWVpOJOY3V3lo0uqEg/GM0DB36MRhIT2AR+fm/c kxbVApsVg3Htq7UcYly1r5X08ShErCnC3vpScWHv0oiGZiwO5SnW1I2leQUv3CmS VL7x8cbwr9vdwbcrSc4kFPAGRnV/KuX76MwQmtOp1ueL+WoVlaLNxR/yk= 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=YUfRoZv9KL6hrAOZx7LQ5sq939Y=; b=vmTDZc48BjbD3RxAec9w JbKsoLdFVqtLw4QVQVSSCMtiOjA3guxf04Fn7LDOYBID1IASM7Mx7Dnp3J19Wtv/ CsmREZ1dnVbE9ePCrJMOI5G4cs53PWoop7vGFTYj0LCL/sRHI5UxjcS/WIbq7q4+ R9s3z5sJCC/Ba65Z0AyJo9k= Received: (qmail 28083 invoked by alias); 20 Feb 2014 14:05:06 -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 27962 invoked by uid 89); 20 Feb 2014 14:05:05 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.5 required=5.0 tests=BAYES_05 autolearn=ham version=3.3.2 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; Thu, 20 Feb 2014 14:05:04 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5DBE111670D; Thu, 20 Feb 2014 09:05:02 -0500 (EST) 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 P-aaekc-D+jD; Thu, 20 Feb 2014 09:05:02 -0500 (EST) Received: from kwai.gnat.com (unknown [IPv6:2620:20:4000:0:a6ba:dbff:fe26:1f63]) by rock.gnat.com (Postfix) with ESMTP id 4C1C0116700; Thu, 20 Feb 2014 09:05:02 -0500 (EST) Received: by kwai.gnat.com (Postfix, from userid 4192) id 4B19F3FF06; Thu, 20 Feb 2014 09:05:02 -0500 (EST) Date: Thu, 20 Feb 2014 09:05:02 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Proper handling of Raise_Expression nodes in Ada 2012 Message-ID: <20140220140502.GA18237@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.21 (2010-09-15) A Raise_Expression is expected to be of any type, and can appear as a component of any expression. This patch introduces a new type Raise_Type, that is the initial type of such a node prior to full resolution. A Raise_Expression node must eventually carry the type imposed by the context. If the type of the context itself is Raise_Type this indicates that the expression is ambiguous and must be rejected, as in (raise Constraint_Error) /= (raise Storage_Error). Compiling raise_ambig.ads must yield: raise_ambig.ads:2:17: cannot find unique type for raise expression raise_ambig.ads:2:45: cannot find unique type for raise expression --- package Raise_Ambig is B : Boolean := (raise constraint_error) /= (raise storage_error); end; -- The following must compile quietly: --- package CaseExprRaise is B : constant BOOLEAN := (case false is when False => raise Constraint_Error, when True => raise Constraint_Error); X : Integer := (raise constraint_error) + (raise storage_error); Y : Integer := (raise constraint_error) + 1; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2014-02-20 Ed Schonberg * stand.ads: Raise_Type: new predefined entity, used as the type of a Raise_Expression prior to resolution. * cstand.adb: Build entity for Raise_Type. * sem_ch11.adb (Analyze_Raise_Expression): use Raise_Type as the initial type of the node. * sem_type.adb (Covers): Raise_Type is compatible with all other types. * sem_res.adb (Resolve): Remove special handling of Any_Type on Raise_Expression nodes. (Resolve_Raise_Expression): Signal ambiguity if the type of the context is still Raise_Type. Index: sem_type.adb =================================================================== --- sem_type.adb (revision 207879) +++ sem_type.adb (working copy) @@ -1128,6 +1128,11 @@ elsif BT2 = Any_Type then return True; + -- A Raise_Expressions is legal in any expression context. + + elsif BT2 = Raise_Type then + return True; + -- A packed array type covers its corresponding non-packed type. This is -- not legitimate Ada, but allows the omission of a number of otherwise -- useless unchecked conversions, and since this can only arise in Index: sem_res.adb =================================================================== --- sem_res.adb (revision 207942) +++ sem_res.adb (working copy) @@ -2060,18 +2060,9 @@ Analyze_Dimension (N); return; - -- A Raise_Expression takes its type from context. The Etype was set - -- to Any_Type, reflecting the fact that the expression itself does - -- not specify any possible interpretation. So we set the type to the - -- resolution type here and now. We need to do this before Resolve sees - -- the Any_Type value. + -- Any case of Any_Type as the Etype value means that we had a + -- previous error. - elsif Nkind (N) = N_Raise_Expression then - Set_Etype (N, Typ); - - -- Any other case of Any_Type as the Etype value means that we had - -- a previous error. - elsif Etype (N) = Any_Type then Debug_A_Exit ("resolving ", N, " (done, Etype = Any_Type)"); return; @@ -7405,6 +7396,16 @@ Check_Fully_Declared_Prefix (Typ, P); P_Typ := Empty; + -- A useful optimization: check whether the dereference denotes an + -- element of a container, and if so rewrite it as a call to the + -- corresponding Element function. + -- Disabled for now, on advice of ARG. A more restricted form of the + -- predicate might be acceptable ??? + + -- if Is_Container_Element (N) then + -- return; + -- end if; + if Is_Overloaded (P) then -- Use the context type to select the prefix that has the correct @@ -8816,7 +8817,12 @@ procedure Resolve_Raise_Expression (N : Node_Id; Typ : Entity_Id) is begin - Set_Etype (N, Typ); + if Typ = Raise_Type then + Error_Msg_N ("cannot find unique type for raise expression", N); + Set_Etype (N, Any_Type); + else + Set_Etype (N, Typ); + end if; end Resolve_Raise_Expression; ------------------- Index: cstand.adb =================================================================== --- cstand.adb (revision 207879) +++ cstand.adb (working copy) @@ -1321,6 +1321,13 @@ Set_First_Index (Any_String, Index); end; + Raise_Type := New_Standard_Entity; + Decl := New_Node (N_Full_Type_Declaration, Stloc); + Set_Defining_Identifier (Decl, Raise_Type); + Set_Scope (Raise_Type, Standard_Standard); + Build_Signed_Integer_Type (Raise_Type, Standard_Integer_Size); + Make_Name (Raise_Type, "any type"); + Standard_Integer_8 := New_Standard_Entity; Decl := New_Node (N_Full_Type_Declaration, Stloc); Set_Defining_Identifier (Decl, Standard_Integer_8); Index: stand.ads =================================================================== --- stand.ads (revision 207879) +++ stand.ads (working copy) @@ -371,14 +371,6 @@ -- candidate interpretations has been examined. If after examining all of -- them the type is still Any_Type, the node has no possible interpretation -- and an error can be emitted (and Any_Type will be propagated upwards). - -- - -- There is one situation in which Any_Type is used to legitimately - -- represent a case where the type is not known pre-resolution, and that - -- is for the N_Raise_Expression node. In this case, the Etype being set to - -- Any_Type is normal and does not represent an error. In particular, it is - -- compatible with the type of any constituent of the enclosing expression, - -- if any. The type is eventually replaced with the type of the context, - -- which plays no role in the resolution of the Raise_Expression. Any_Access : Entity_Id; -- Used to resolve the overloaded literal NULL @@ -427,6 +419,11 @@ -- component type is compatible with any character type, not just -- Standard_Character. + Raise_Type : Entity_Id; + -- The type Raise_Type denotes the type of a Raise_Expression. It is + -- compatible with all other types, and must eventually resolve to a + -- concrete type that is imposed by the context. + Universal_Integer : Entity_Id; -- Entity for universal integer type. The bounds of this type correspond -- to the largest supported integer type (i.e. Long_Long_Integer). It is Index: sem_ch11.adb =================================================================== --- sem_ch11.adb (revision 207879) +++ sem_ch11.adb (working copy) @@ -475,9 +475,11 @@ Kill_Current_Values (Last_Assignment_Only => True); - -- Set type as Any_Type since we have no information at all on the type + -- Raise_Type is compatible with all other types so that the raise + -- expression is legal in any expression context. It will be eventually + -- replaced by the concrete type imposed by the context. - Set_Etype (N, Any_Type); + Set_Etype (N, Raise_Type); end Analyze_Raise_Expression; -----------------------------