-- Has_Pragma_Preelab_Init Flag221
-- Used_As_Generic_Actual Flag222
- -- (unused) Flag223
- -- (unused) Flag224
+ -- Is_Descendent_Of_Address Flag223
+ -- Is_Raised Flag224
-- (unused) Flag225
-- (unused) Flag226
-- (unused) Flag227
return Flag176 (Id);
end Is_Discrim_SO_Function;
+ function Is_Descendent_Of_Address (Id : E) return B is
+ begin
+ pragma Assert (Is_Type (Id));
+ return Flag223 (Id);
+ end Is_Descendent_Of_Address;
+
function Is_Dispatching_Operation (Id : E) return B is
begin
pragma Assert (Nkind (Id) in N_Entity);
return Flag189 (Id);
end Is_Pure_Unit_Access_Type;
+ function Is_Raised (Id : E) return B is
+ begin
+ pragma Assert (Ekind (Id) = E_Exception);
+ return Flag224 (Id);
+ end Is_Raised;
+
function Is_Remote_Call_Interface (Id : E) return B is
begin
return Flag62 (Id);
Set_Flag74 (Id, V);
end Set_Is_CPP_Class;
+ procedure Set_Is_Descendent_Of_Address (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Type (Id));
+ Set_Flag223 (Id, V);
+ end Set_Is_Descendent_Of_Address;
+
procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True) is
begin
Set_Flag176 (Id, V);
Set_Flag189 (Id, V);
end Set_Is_Pure_Unit_Access_Type;
+ procedure Set_Is_Raised (Id : E; V : B := True) is
+ begin
+ pragma Assert (Ekind (Id) = E_Exception);
+ Set_Flag224 (Id, V);
+ end Set_Is_Raised;
+
procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True) is
begin
Set_Flag62 (Id, V);
W ("Is_Constructor", Flag76 (Id));
W ("Is_Controlled", Flag42 (Id));
W ("Is_Controlling_Formal", Flag97 (Id));
+ W ("Is_Descendent_Of_Address", Flag223 (Id));
W ("Is_Discrim_SO_Function", Flag176 (Id));
W ("Is_Dispatching_Operation", Flag6 (Id));
W ("Is_Eliminated", Flag124 (Id));
W ("Is_Public", Flag10 (Id));
W ("Is_Pure", Flag44 (Id));
W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
+ W ("Is_Raised", Flag224 (Id));
W ("Is_Remote_Call_Interface", Flag62 (Id));
W ("Is_Remote_Types", Flag61 (Id));
W ("Is_Renaming_Of_Object", Flag112 (Id));
-- Applies to all entities. Determine if given entity is a derived type.
-- Always false if argument is not a type.
+-- Is_Descendent_Of_Address (Flag223)
+-- Applies to all types. Indicates that a type is an address type that
+-- is visibly a numeric type. Used for semantic checks on VMS to remove
+-- ambiguities in universal integer expressions that may have an address
+-- interpretation
+
-- Is_Discrete_Type (synthesized)
-- Applies to all entities, true for all discrete types and subtypes
-- subtype appears in a pure unit. Used to give an error message at
-- freeze time if the access type has a storage pool.
+-- Is_Raised (Flag224)
+-- Present in entities which denote exceptions. Set if the exception is
+-- thrown by a raise statement.
+
-- Is_Real_Type (synthesized)
-- Applies to all entities, true for real types and subtypes
-- Exception_Code (Uint22)
-- Discard_Names (Flag88)
-- Is_VMS_Exception (Flag133)
+ -- Is_Raised (Flag224)
-- E_Exception_Type
-- Equivalent_Type (Node18)
function Is_Public (Id : E) return B;
function Is_Pure (Id : E) return B;
function Is_Pure_Unit_Access_Type (Id : E) return B;
+ function Is_Raised (Id : E) return B;
function Is_Remote_Call_Interface (Id : E) return B;
function Is_Remote_Types (Id : E) return B;
function Is_Renaming_Of_Object (Id : E) return B;
function Is_Concurrent_Type (Id : E) return B;
function Is_Decimal_Fixed_Point_Type (Id : E) return B;
function Is_Digits_Type (Id : E) return B;
+ function Is_Descendent_Of_Address (Id : E) return B;
function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B;
function Is_Discrete_Type (Id : E) return B;
function Is_Elementary_Type (Id : E) return B;
procedure Set_Is_Constructor (Id : E; V : B := True);
procedure Set_Is_Controlled (Id : E; V : B := True);
procedure Set_Is_Controlling_Formal (Id : E; V : B := True);
+ procedure Set_Is_Descendent_Of_Address (Id : E; V : B := True);
procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True);
procedure Set_Is_Dispatching_Operation (Id : E; V : B := True);
procedure Set_Is_Eliminated (Id : E; V : B := True);
procedure Set_Is_Public (Id : E; V : B := True);
procedure Set_Is_Pure (Id : E; V : B := True);
procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True);
+ procedure Set_Is_Raised (Id : E; V : B := True);
procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True);
procedure Set_Is_Remote_Types (Id : E; V : B := True);
procedure Set_Is_Renaming_Of_Object (Id : E; V : B := True);
pragma Inline (Is_Decimal_Fixed_Point_Type);
pragma Inline (Is_Discrim_SO_Function);
pragma Inline (Is_Digits_Type);
+ pragma Inline (Is_Descendent_Of_Address);
pragma Inline (Is_Discrete_Or_Fixed_Point_Type);
pragma Inline (Is_Discrete_Type);
pragma Inline (Is_Dispatching_Operation);
pragma Inline (Is_Public);
pragma Inline (Is_Pure);
pragma Inline (Is_Pure_Unit_Access_Type);
+ pragma Inline (Is_Raised);
pragma Inline (Is_Real_Type);
pragma Inline (Is_Record_Type);
pragma Inline (Is_Remote_Call_Interface);
pragma Inline (Set_Is_Constructor);
pragma Inline (Set_Is_Controlled);
pragma Inline (Set_Is_Controlling_Formal);
+ pragma Inline (Set_Is_Descendent_Of_Address);
pragma Inline (Set_Is_Discrim_SO_Function);
pragma Inline (Set_Is_Dispatching_Operation);
pragma Inline (Set_Is_Eliminated);
pragma Inline (Set_Is_Public);
pragma Inline (Set_Is_Pure);
pragma Inline (Set_Is_Pure_Unit_Access_Type);
+ pragma Inline (Set_Is_Raised);
pragma Inline (Set_Is_Remote_Call_Interface);
pragma Inline (Set_Is_Remote_Types);
pragma Inline (Set_Is_Renaming_Of_Object);
Error_Msg_N ("exception name expected", Id);
else
+ -- Emit a warning at the declaration level when a local
+ -- exception is never raised explicitly.
+
+ if Warn_On_Redundant_Constructs
+ and then not Is_Raised (Entity (Id))
+ and then Scope (Entity (Id)) = Current_Scope
+ then
+ Error_Msg_NE
+ ("?exception & is never raised", Entity (Id), Id);
+ end if;
+
if Present (Renamed_Entity (Entity (Id))) then
if Entity (Id) = Standard_Numeric_Error then
Check_Restriction (No_Obsolescent_Features, Id);
then
Error_Msg_N
("exception name expected in raise statement", Exception_Id);
+ else
+ Set_Is_Raised (Exception_Name);
end if;
if Present (Expression (N)) then