-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- safely used by New_Copy_Tree, since there is no case of a recursive
-- call from the processing inside New_Copy_Tree.
- NCT_Hash_Threshhold : constant := 20;
+ NCT_Hash_Threshold : constant := 20;
-- If there are more than this number of pairs of entries in the
-- map, then Hash_Tables_Used will be set, and the hash tables will
-- be initialized and used for the searches.
-- Set to True if hash tables are in use
NCT_Table_Entries : Nat;
- -- Count entries in table to see if threshhold is reached
+ -- Count entries in table to see if threshold is reached
NCT_Hash_Table_Setup : Boolean := False;
-- Set to True if hash table contains data. We set this True if we
-- whether the corresponding formal is OUT or IN OUT. Each top-level call
-- (procedure call, condition, assignment) examines all the actuals for a
-- possible order dependence. The table is reset after each such check.
+ -- The actuals to be checked in a call to Check_Order_Dependence are at
+ -- positions 1 .. Last.
type Actual_Name is record
Act : Node_Id;
Is_Writable : Boolean;
- -- Comments needed???
-
end record;
package Actuals_In_Call is new Table.Table (
end if;
end Apply_Compile_Time_Constraint_Error;
+ --------------------------------
+ -- Bad_Predicated_Subtype_Use --
+ --------------------------------
+
+ procedure Bad_Predicated_Subtype_Use
+ (Msg : String;
+ N : Node_Id;
+ Typ : Entity_Id)
+ is
+ begin
+ if Has_Predicates (Typ) then
+ if Is_Generic_Actual_Type (Typ) then
+ Error_Msg_FE (Msg & '?', N, Typ);
+ Error_Msg_F ("\Program_Error will be raised at run time?", N);
+ Insert_Action (N,
+ Make_Raise_Program_Error (Sloc (N),
+ Reason => PE_Bad_Predicated_Generic_Type));
+
+ else
+ Error_Msg_FE (Msg, N, Typ);
+ end if;
+ end if;
+ end Bad_Predicated_Subtype_Use;
+
--------------------------
-- Build_Actual_Subtype --
--------------------------
Act2 : Node_Id;
begin
- -- This could use comments ???
+ if Ada_Version < Ada_2012 then
+ return;
+ end if;
+
+ -- Ada 2012 AI04-0144-2: Dangerous order dependence. Actuals in nested
+ -- calls within a construct have been collected. If one of them is
+ -- writable and overlaps with another one, evaluation of the enclosing
+ -- construct is nondeterministic. This is illegal in Ada 2012, but is
+ -- treated as a warning for now.
- for J in 0 .. Actuals_In_Call.Last loop
+ for J in 1 .. Actuals_In_Call.Last loop
if Actuals_In_Call.Table (J).Is_Writable then
Act1 := Actuals_In_Call.Table (J).Act;
Act1 := Prefix (Act1);
end if;
- for K in 0 .. Actuals_In_Call.Last loop
+ for K in 1 .. Actuals_In_Call.Last loop
if K /= J then
Act2 := Actuals_In_Call.Table (K).Act;
null;
elsif Denotes_Same_Object (Act1, Act2)
- and then False
+ and then Parent (Act1) /= Parent (Act2)
then
- Error_Msg_N ("?,mighty suspicious!!!", Act1);
+ Error_Msg_N
+ ("result may differ if evaluated "
+ & "after other actual in expression?", Act1);
end if;
end if;
end loop;
end if;
end loop;
+ -- Remove checked actuals from table
+
Actuals_In_Call.Set_Last (0);
end Check_Order_Dependence;
procedure Check_Potentially_Blocking_Operation (N : Node_Id) is
S : Entity_Id;
+
begin
-- N is one of the potentially blocking operations listed in 9.5.1(8).
-- When pragma Detect_Blocking is active, the run time will raise
if Is_Protected_Type (S) then
Error_Msg_N
("potentially blocking operation in protected operation?", N);
-
return;
end if;
if Chars (Id) = Name_Op_Eq
and then Is_Dispatching_Operation (Id)
and then Present (Alias (Id))
- and then Is_Overriding_Operation (Alias (Id))
+ and then Present (Overridden_Operation (Alias (Id)))
and then Base_Type (Etype (First_Entity (Id))) =
Base_Type (Etype (First_Entity (Alias (Id))))
then
-------------------------
function Denotes_Same_Object (A1, A2 : Node_Id) return Boolean is
+ Obj1 : Node_Id := A1;
+ Obj2 : Node_Id := A2;
+
+ procedure Check_Renaming (Obj : in out Node_Id);
+ -- If an object is a renaming, examine renamed object. If it is a
+ -- dereference of a variable, or an indexed expression with non-constant
+ -- indexes, no overlap check can be reported.
+
+ --------------------
+ -- Check_Renaming --
+ --------------------
+
+ procedure Check_Renaming (Obj : in out Node_Id) is
+ begin
+ if Is_Entity_Name (Obj)
+ and then Present (Renamed_Entity (Entity (Obj)))
+ then
+ Obj := Renamed_Entity (Entity (Obj));
+ if Nkind (Obj) = N_Explicit_Dereference
+ and then Is_Variable (Prefix (Obj))
+ then
+ Obj := Empty;
+
+ elsif Nkind (Obj) = N_Indexed_Component then
+ declare
+ Indx : Node_Id;
+
+ begin
+ Indx := First (Expressions (Obj));
+ while Present (Indx) loop
+ if not Is_OK_Static_Expression (Indx) then
+ Obj := Empty;
+ exit;
+ end if;
+
+ Next_Index (Indx);
+ end loop;
+ end;
+ end if;
+ end if;
+ end Check_Renaming;
+
+ -- Start of processing for Denotes_Same_Object
+
begin
+ Check_Renaming (Obj1);
+ Check_Renaming (Obj2);
+
+ if No (Obj1)
+ or else No (Obj2)
+ then
+ return False;
+ end if;
+
-- If we have entity names, then must be same entity
- if Is_Entity_Name (A1) then
- if Is_Entity_Name (A2) then
- return Entity (A1) = Entity (A2);
+ if Is_Entity_Name (Obj1) then
+ if Is_Entity_Name (Obj2) then
+ return Entity (Obj1) = Entity (Obj2);
else
return False;
end if;
-- No match if not same node kind
- elsif Nkind (A1) /= Nkind (A2) then
+ elsif Nkind (Obj1) /= Nkind (Obj2) then
return False;
-- For selected components, must have same prefix and selector
- elsif Nkind (A1) = N_Selected_Component then
- return Denotes_Same_Object (Prefix (A1), Prefix (A2))
+ elsif Nkind (Obj1) = N_Selected_Component then
+ return Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2))
and then
- Entity (Selector_Name (A1)) = Entity (Selector_Name (A2));
+ Entity (Selector_Name (Obj1)) = Entity (Selector_Name (Obj2));
-- For explicit dereferences, prefixes must be same
- elsif Nkind (A1) = N_Explicit_Dereference then
- return Denotes_Same_Object (Prefix (A1), Prefix (A2));
+ elsif Nkind (Obj1) = N_Explicit_Dereference then
+ return Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2));
-- For indexed components, prefixes and all subscripts must be the same
- elsif Nkind (A1) = N_Indexed_Component then
- if Denotes_Same_Object (Prefix (A1), Prefix (A2)) then
+ elsif Nkind (Obj1) = N_Indexed_Component then
+ if Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2)) then
declare
Indx1 : Node_Id;
Indx2 : Node_Id;
begin
- Indx1 := First (Expressions (A1));
- Indx2 := First (Expressions (A2));
+ Indx1 := First (Expressions (Obj1));
+ Indx2 := First (Expressions (Obj2));
while Present (Indx1) loop
- -- Shouldn't we be checking that values are the same???
+ -- Indexes must denote the same static value or same object
- if not Denotes_Same_Object (Indx1, Indx2) then
+ if Is_OK_Static_Expression (Indx1) then
+ if not Is_OK_Static_Expression (Indx2) then
+ return False;
+
+ elsif Expr_Value (Indx1) /= Expr_Value (Indx2) then
+ return False;
+ end if;
+
+ elsif not Denotes_Same_Object (Indx1, Indx2) then
return False;
end if;
-- For slices, prefixes must match and bounds must match
- elsif Nkind (A1) = N_Slice
- and then Denotes_Same_Object (Prefix (A1), Prefix (A2))
+ elsif Nkind (Obj1) = N_Slice
+ and then Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2))
then
declare
Lo1, Lo2, Hi1, Hi2 : Node_Id;
begin
- Get_Index_Bounds (Etype (A1), Lo1, Hi1);
- Get_Index_Bounds (Etype (A2), Lo2, Hi2);
+ Get_Index_Bounds (Etype (Obj1), Lo1, Hi1);
+ Get_Index_Bounds (Etype (Obj2), Lo2, Hi2);
-- Check whether bounds are statically identical. There is no
-- attempt to detect partial overlap of slices.
- -- What about an array and a slice of an array???
-
return Denotes_Same_Object (Lo1, Lo2)
and then Denotes_Same_Object (Hi1, Hi2);
end;
-- Literals will appear as indexes. Isn't this where we should check
-- Known_At_Compile_Time at least if we are generating warnings ???
- elsif Nkind (A1) = N_Integer_Literal then
- return Intval (A1) = Intval (A2);
+ elsif Nkind (Obj1) = N_Integer_Literal then
+ return Intval (Obj1) = Intval (Obj2);
else
return False;
Set_Scope (Def_Id, Current_Scope);
return;
- -- Analogous to privals, the discriminal generated for an entry
- -- index parameter acts as a weak declaration. Perform minimal
- -- decoration to avoid bogus errors.
+ -- Analogous to privals, the discriminal generated for an entry index
+ -- parameter acts as a weak declaration. Perform minimal decoration
+ -- to avoid bogus errors.
elsif Is_Discriminal (Def_Id)
and then Ekind (Discriminal_Link (Def_Id)) = E_Entry_Index_Parameter
Set_Scope (Def_Id, Current_Scope);
return;
- -- In the body or private part of an instance, a type extension
- -- may introduce a component with the same name as that of an
- -- actual. The legality rule is not enforced, but the semantics
- -- of the full type with two components of the same name are not
- -- clear at this point ???
+ -- In the body or private part of an instance, a type extension may
+ -- introduce a component with the same name as that of an actual. The
+ -- legality rule is not enforced, but the semantics of the full type
+ -- with two components of same name are not clear at this point???
elsif In_Instance_Not_Visible then
null;
then
null;
- -- Conversely, with front-end inlining we may compile the parent
- -- body first, and a child unit subsequently. The context is now
- -- the parent spec, and body entities are not visible.
+ -- Conversely, with front-end inlining we may compile the parent body
+ -- first, and a child unit subsequently. The context is now the
+ -- parent spec, and body entities are not visible.
elsif Is_Child_Unit (Def_Id)
and then Is_Package_Body_Entity (E)
Error_Msg_Sloc := Sloc (E);
-- If the previous declaration is an incomplete type declaration
- -- this may be an attempt to complete it with a private type.
- -- The following avoids confusing cascaded errors.
+ -- this may be an attempt to complete it with a private type. The
+ -- following avoids confusing cascaded errors.
if Nkind (Parent (E)) = N_Incomplete_Type_Declaration
and then Nkind (Parent (Def_Id)) = N_Private_Type_Declaration
Error_Msg_N ("& conflicts with declaration#", E);
return;
- -- If the name of the unit appears in its own context clause,
- -- a dummy package with the name has already been created, and
- -- the error emitted. Try to continue quietly.
+ -- If the name of the unit appears in its own context clause, a
+ -- dummy package with the name has already been created, and the
+ -- error emitted. Try to continue quietly.
elsif Error_Posted (E)
and then Sloc (E) = No_Location
Error_Msg_N ("\generic units cannot be overloaded", Def_Id);
end if;
- -- If entity is in standard, then we are in trouble, because
- -- it means that we have a library package with a duplicated
- -- name. That's hard to recover from, so abort!
+ -- If entity is in standard, then we are in trouble, because it
+ -- means that we have a library package with a duplicated name.
+ -- That's hard to recover from, so abort!
if S = Standard_Standard then
raise Unrecoverable_Error;
end if;
end if;
- -- If we fall through, declaration is OK , or OK enough to continue
+ -- If we fall through, declaration is OK, at least OK enough to continue
- -- If Def_Id is a discriminant or a record component we are in the
- -- midst of inheriting components in a derived record definition.
- -- Preserve their Ekind and Etype.
+ -- If Def_Id is a discriminant or a record component we are in the midst
+ -- of inheriting components in a derived record definition. Preserve
+ -- their Ekind and Etype.
if Ekind_In (Def_Id, E_Discriminant, E_Component) then
null;
- -- If a type is already set, leave it alone (happens whey a type
- -- declaration is reanalyzed following a call to the optimizer)
+ -- If a type is already set, leave it alone (happens when a type
+ -- declaration is reanalyzed following a call to the optimizer).
elsif Present (Etype (Def_Id)) then
null;
and then In_Extended_Main_Source_Unit (Def_Id)
- -- Finally, the hidden entity must be either immediately visible
- -- or use visible (from a used package)
+ -- Finally, the hidden entity must be either immediately visible or
+ -- use visible (i.e. from a used package).
and then
(Is_Immediately_Visible (C)
function Has_Overriding_Initialize (T : Entity_Id) return Boolean is
BT : constant Entity_Id := Base_Type (T);
- Comp : Entity_Id;
P : Elmt_Id;
begin
if Is_Controlled (BT) then
-
- -- For derived types, check immediate ancestor, excluding
- -- Controlled itself.
-
- if Is_Derived_Type (BT)
- and then not In_Predefined_Unit (Etype (BT))
- and then Has_Overriding_Initialize (Etype (BT))
- then
- return True;
+ if Is_RTU (Scope (BT), Ada_Finalization) then
+ return False;
elsif Present (Primitive_Operations (BT)) then
P := First_Elmt (Primitive_Operations (BT));
while Present (P) loop
- if Chars (Node (P)) = Name_Initialize
- and then Comes_From_Source (Node (P))
- then
- return True;
- end if;
+ declare
+ Init : constant Entity_Id := Node (P);
+ Formal : constant Entity_Id := First_Formal (Init);
+ begin
+ if Ekind (Init) = E_Procedure
+ and then Chars (Init) = Name_Initialize
+ and then Comes_From_Source (Init)
+ and then Present (Formal)
+ and then Etype (Formal) = BT
+ and then No (Next_Formal (Formal))
+ and then (Ada_Version < Ada_2012
+ or else not Null_Present (Parent (Init)))
+ then
+ return True;
+ end if;
+ end;
Next_Elmt (P);
end loop;
end if;
- return False;
+ -- Here if type itself does not have a non-null Initialize operation:
+ -- check immediate ancestor.
- elsif Has_Controlled_Component (BT) then
- Comp := First_Component (BT);
- while Present (Comp) loop
- if Has_Overriding_Initialize (Etype (Comp)) then
- return True;
- end if;
-
- Next_Component (Comp);
- end loop;
-
- return False;
-
- else
- return False;
+ if Is_Derived_Type (BT)
+ and then Has_Overriding_Initialize (Etype (BT))
+ then
+ return True;
+ end if;
end if;
+
+ return False;
end Has_Overriding_Initialize;
--------------------------------------
-- We are interested only in components and discriminants
- if Ekind_In (Ent, E_Component, E_Discriminant) then
+ Exp := Empty;
- -- Get default expression if any. If there is no declaration
- -- node, it means we have an internal entity. The parent and
- -- tag fields are examples of such entities. For these cases,
- -- we just test the type of the entity.
+ case Ekind (Ent) is
+ when E_Component =>
- if Present (Declaration_Node (Ent)) then
- Exp := Expression (Declaration_Node (Ent));
- else
- Exp := Empty;
- end if;
-
- -- A component has PI if it has no default expression and the
- -- component type has PI.
+ -- Get default expression if any. If there is no declaration
+ -- node, it means we have an internal entity. The parent and
+ -- tag fields are examples of such entities. For such cases,
+ -- we just test the type of the entity.
- if No (Exp) then
- if not Has_Preelaborable_Initialization (Etype (Ent)) then
- Has_PE := False;
- exit;
+ if Present (Declaration_Node (Ent)) then
+ Exp := Expression (Declaration_Node (Ent));
end if;
- -- Require the default expression to be preelaborable
+ when E_Discriminant =>
+
+ -- Note: for a renamed discriminant, the Declaration_Node
+ -- may point to the one from the ancestor, and have a
+ -- different expression, so use the proper attribute to
+ -- retrieve the expression from the derived constraint.
+
+ Exp := Discriminant_Default_Value (Ent);
+
+ when others =>
+ goto Check_Next_Entity;
+ end case;
- elsif not Is_Preelaborable_Expression (Exp) then
+ -- A component has PI if it has no default expression and the
+ -- component type has PI.
+
+ if No (Exp) then
+ if not Has_Preelaborable_Initialization (Etype (Ent)) then
Has_PE := False;
exit;
end if;
+
+ -- Require the default expression to be preelaborable
+
+ elsif not Is_Preelaborable_Expression (Exp) then
+ Has_PE := False;
+ exit;
end if;
+ <<Check_Next_Entity>>
Next_Entity (Ent);
end loop;
end Check_Components;
end loop;
end Inspect_Deferred_Constant_Completion;
- -------------------
- -- Is_AAMP_Float --
- -------------------
-
- function Is_AAMP_Float (E : Entity_Id) return Boolean is
- pragma Assert (Is_Type (E));
- begin
- return AAMP_On_Target
- and then Is_Floating_Point_Type (E)
- and then E = Base_Type (E);
- end Is_AAMP_Float;
-
-----------------------------
-- Is_Actual_Out_Parameter --
-----------------------------
end if;
end Is_Fully_Initialized_Variant;
- -----------------------
- -- Is_Generic_Formal --
- -----------------------
-
- function Is_Generic_Formal (E : Entity_Id) return Boolean is
- Kind : Node_Kind;
- begin
- if No (E) then
- return False;
- else
- Kind := Nkind (Parent (E));
- return
- Nkind_In (Kind, N_Formal_Object_Declaration,
- N_Formal_Package_Declaration,
- N_Formal_Type_Declaration)
- or else Is_Formal_Subprogram (E);
- end if;
- end Is_Generic_Formal;
-
------------
-- Is_LHS --
------------
function Is_LHS (N : Node_Id) return Boolean is
P : constant Node_Id := Parent (N);
+
begin
- return Nkind (P) = N_Assignment_Statement
- and then Name (P) = N;
+ if Nkind (P) = N_Assignment_Statement then
+ return Name (P) = N;
+
+ elsif
+ Nkind_In (P, N_Indexed_Component, N_Selected_Component, N_Slice)
+ then
+ return N = Prefix (P) and then Is_LHS (P);
+
+ else
+ return False;
+ end if;
end Is_LHS;
----------------------------
-- Is_Partially_Initialized_Type --
-----------------------------------
- function Is_Partially_Initialized_Type (Typ : Entity_Id) return Boolean is
+ function Is_Partially_Initialized_Type
+ (Typ : Entity_Id;
+ Include_Implicit : Boolean := True) return Boolean
+ is
begin
if Is_Scalar_Type (Typ) then
return False;
elsif Is_Access_Type (Typ) then
- return True;
+ return Include_Implicit;
elsif Is_Array_Type (Typ) then
-- If component type is partially initialized, so is array type
- if Is_Partially_Initialized_Type (Component_Type (Typ)) then
+ if Is_Partially_Initialized_Type
+ (Component_Type (Typ), Include_Implicit)
+ then
return True;
-- Otherwise we are only partially initialized if we are fully
elsif Is_Record_Type (Typ) then
- -- A discriminated type is always partially initialized
+ -- A discriminated type is always partially initialized if in
+ -- all mode
- if Has_Discriminants (Typ) then
+ if Has_Discriminants (Typ) and then Include_Implicit then
return True;
-- A tagged type is always partially initialized
-- If a component is of a type which is itself partially
-- initialized, then the enclosing record type is also.
- elsif Is_Partially_Initialized_Type (Etype (Ent)) then
+ elsif Is_Partially_Initialized_Type
+ (Etype (Ent), Include_Implicit)
+ then
return True;
end if;
end if;
if No (U) then
return True;
else
- return Is_Partially_Initialized_Type (U);
+ return Is_Partially_Initialized_Type (U, Include_Implicit);
end if;
end;
when N_Explicit_Dereference =>
return False;
- -- Function call arguments are never lvalues
-
- when N_Function_Call =>
- return False;
+ -- Positional parameter for subprogram, entry, or accept call.
+ -- In older versions of Ada function call arguments are never
+ -- lvalues. In Ada 2012 functions can have in-out parameters.
- -- Positional parameter for procedure, entry, or accept call
-
- when N_Procedure_Call_Statement |
+ when N_Function_Call |
+ N_Procedure_Call_Statement |
N_Entry_Call_Statement |
N_Accept_Statement
=>
+ if Nkind (P) = N_Function_Call
+ and then Ada_Version < Ada_2012
+ then
+ return False;
+ end if;
+
+ -- The following mechanism is clumsy and fragile. A single
+ -- flag set in Resolve_Actuals would be preferable ???
+
declare
Proc : Entity_Id;
Form : Entity_Id;
-- Itype references within the copied tree.
-- The following hash tables are used if the Map supplied has more
- -- than hash threshhold entries to speed up access to the map. If
+ -- than hash threshold entries to speed up access to the map. If
-- there are fewer entries, then the map is searched sequentially
-- (because setting up a hash table for only a few entries takes
-- more time than it saves.
else
NCT_Table_Entries := NCT_Table_Entries + 1;
- if NCT_Table_Entries > NCT_Hash_Threshhold then
+ if NCT_Table_Entries > NCT_Hash_Threshold then
Build_NCT_Hash_Tables;
end if;
end if;
Next_Elmt (Elmt);
end loop;
- if NCT_Table_Entries > NCT_Hash_Threshhold then
+ if NCT_Table_Entries > NCT_Hash_Threshold then
Build_NCT_Hash_Tables;
else
NCT_Hash_Tables_Used := False;
if Modification_Comes_From_Source then
Generate_Reference (Ent, Exp, 'm');
+
+ -- If the target of the assignment is the bound variable
+ -- in an iterator, indicate that the corresponding array
+ -- or container is also modified.
+
+ if Ada_Version >= Ada_2012
+ and then
+ Nkind (Parent (Ent)) = N_Iterator_Specification
+ then
+ declare
+ Domain : constant Node_Id := Name (Parent (Ent));
+
+ begin
+ -- TBD : in the full version of the construct, the
+ -- domain of iteration can be given by an expression.
+
+ if Is_Entity_Name (Domain) then
+ Generate_Reference (Entity (Domain), Exp, 'm');
+ Set_Is_True_Constant (Entity (Domain), False);
+ Set_Never_Set_In_Source (Entity (Domain), False);
+ end if;
+ end;
+ end if;
end if;
Check_Nested_Access (Ent);
then
return Original_Corresponding_Operation (Alias (S));
- -- If S overrides an inherted subprogram S2 the original corresponding
+ -- If S overrides an inherited subprogram S2 the original corresponding
-- operation of S is the original corresponding operation of S2
- elsif Is_Overriding_Operation (S)
- and then Present (Overridden_Operation (S))
- then
+ elsif Present (Overridden_Operation (S)) then
return Original_Corresponding_Operation (Overridden_Operation (S));
-- otherwise it is S itself
if Requires_Transient_Scope (Component_Type (Typ)) then
return True;
- -- Otherwise, we only need a transient scope if the size is not
- -- known at compile time.
+ -- Otherwise, we only need a transient scope if the size depends on
+ -- the value of one or more discriminants.
else
- return not Size_Known_At_Compile_Time (Typ);
+ return Size_Depends_On_Discriminant (Typ);
end if;
-- All other cases do not require a transient scope
procedure Save_Actual (N : Node_Id; Writable : Boolean := False) is
begin
- if Is_Entity_Name (N)
+ if Ada_Version < Ada_2012 then
+ return;
+
+ elsif Is_Entity_Name (N)
or else
Nkind_In (N, N_Indexed_Component, N_Selected_Component, N_Slice)
or else
end Set_Size_Info;
--------------------
+ -- Static_Boolean --
+ --------------------
+
+ function Static_Boolean (N : Node_Id) return Uint is
+ begin
+ Analyze_And_Resolve (N, Standard_Boolean);
+
+ if N = Error
+ or else Error_Posted (N)
+ or else Etype (N) = Any_Type
+ then
+ return No_Uint;
+ end if;
+
+ if Is_Static_Expression (N) then
+ if not Raises_Constraint_Error (N) then
+ return Expr_Value (N);
+ else
+ return No_Uint;
+ end if;
+
+ elsif Etype (N) = Any_Type then
+ return No_Uint;
+
+ else
+ Flag_Non_Static_Expr
+ ("static boolean expression required here", N);
+ return No_Uint;
+ end if;
+ end Static_Boolean;
+
+ --------------------
-- Static_Integer --
--------------------