diff mbox

[Ada] Proper handling of Raise_Expression nodes in Ada 2012

Message ID 20140220140502.GA18237@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Feb. 20, 2014, 2:05 p.m. UTC
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  <schonberg@adacore.com>

	* 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.
diff mbox

Patch

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;
 
    -----------------------------