+2018-07-17 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_prag.adb (Has_Visible_State): Do not consider generic formals
+ because they are not part of the visible state space. Add constants to
+ the list of acceptable visible states.
+ (Propagate_Part_Of): Do not consider generic formals when propagating
+ the Part_Of indicator.
+ * sem_util.adb (Entity_Of): Do not follow renaming chains which go
+ through a generic formal because they are not visible for SPARK
+ purposes.
+ * sem_util.ads (Entity_Of): Update the comment on usage.
+
2018-07-17 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Gather_Components): A discriminant of an ancestor may
if not Comes_From_Source (Item_Id) then
null;
+ -- Do not consider generic formals or their corresponding
+ -- actuals because they are not part of a visible state.
+ -- Note that both entities are marked as hidden.
+
+ elsif Is_Hidden (Item_Id) then
+ null;
+
-- The Part_Of indicator turns an abstract state or an
-- object into a constituent of the encapsulating state.
if not Comes_From_Source (Item_Id) then
null;
+ -- Do not consider generic formals or their corresponding actuals
+ -- because they are not part of a visible state. Note that both
+ -- entities are marked as hidden.
+
+ elsif Is_Hidden (Item_Id) then
+ null;
+
-- A visible state has been found
- elsif Ekind_In (Item_Id, E_Abstract_State, E_Variable) then
+ elsif Ekind_In (Item_Id, E_Abstract_State,
+ E_Constant,
+ E_Variable)
+ then
return True;
-- Recursively peek into nested packages and instantiations
-- Ren : ... renames Obj;
if Is_Entity_Name (Ren) then
- Id := Entity (Ren);
+
+ -- Do not follow a renaming that goes through a generic formal,
+ -- because these entities are hidden and must not be referenced
+ -- from outside the generic.
+
+ if Is_Hidden (Entity (Ren)) then
+ exit;
+
+ else
+ Id := Entity (Ren);
+ end if;
-- The reference renames a function result. Check the original
-- node in case expansion relocates the function call.
-- Stored_Constraint as well.
-- An inherited discriminant may have been constrained in a
- -- later ancestor (no the immediate parent) so we must examine
+ -- later ancestor (not the immediate parent) so we must examine
-- the stored constraint of all of them to locate the inherited
-- value.
end loop;
end if;
- -- Discriminant may be inherited from ancestor.
+ -- Discriminant may be inherited from ancestor
T := Etype (T);
end loop;
end;
Loc : Source_Ptr := No_Location;
Rep : Boolean := True;
Warn : Boolean := False);
- -- N is a subexpression which will raise constraint error when evaluated
- -- at runtime. Msg is a message that explains the reason for raising the
+ -- N is a subexpression that will raise Constraint_Error when evaluated
+ -- at run time. Msg is a message that explains the reason for raising the
-- exception. The last character is ? if the message is always a warning,
-- even in Ada 95, and is not a ? if the message represents an illegality
-- (because of violation of static expression rules) in Ada 95 (but not
-- Emit an error if iterated component association N is actually an illegal
-- quantified expression lacking a quantifier.
- function Dynamic_Accessibility_Level (Expr : Node_Id) return Node_Id;
- -- Expr should be an expression of an access type. Builds an integer
- -- literal except in cases involving anonymous access types where
- -- accessibility levels are tracked at runtime (access parameters and Ada
- -- 2012 stand-alone objects).
-
function Discriminated_Size (Comp : Entity_Id) return Boolean;
-- If a component size is not static then a warning will be emitted
-- in Ravenscar or other restricted contexts. When a component is non-
-- static because of a discriminant constraint we can specialize the
-- warning by mentioning discriminants explicitly. This was created for
-- private components of protected objects, but is generally useful when
- -- retriction (No_Implicit_Heap_Allocation) is active.
+ -- restriction No_Implicit_Heap_Allocation is active.
+
+ function Dynamic_Accessibility_Level (Expr : Node_Id) return Node_Id;
+ -- Expr should be an expression of an access type. Builds an integer
+ -- literal except in cases involving anonymous access types, where
+ -- accessibility levels are tracked at run time (access parameters and
+ -- Ada 2012 stand-alone objects).
function Effective_Extra_Accessibility (Id : Entity_Id) return Entity_Id;
-- Same as Einfo.Extra_Accessibility except thtat object renames
function Entity_Of (N : Node_Id) return Entity_Id;
-- Obtain the entity of arbitrary node N. If N is a renaming, return the
-- entity of the earliest renamed source abstract state or whole object.
- -- If no suitable entity is available, return Empty.
+ -- If no suitable entity is available, return Empty. This routine carries
+ -- out actions that are tied to SPARK semantics.
procedure Explain_Limited_Type (T : Entity_Id; N : Node_Id);
-- This procedure is called after issuing a message complaining about an
function Is_Transfer (N : Node_Id) return Boolean;
-- Returns True if the node N is a statement which is known to cause an
- -- unconditional transfer of control at runtime, i.e. the following
+ -- unconditional transfer of control at run time, i.e. the following
-- statement definitely will not be executed.
function Is_True (U : Uint) return Boolean;
projects / gcc.git / commitdiff