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 <schonb...@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.
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;
-----------------------------
