Index : Node_Id;
Into : Node_Id;
Scalar_Comp : Boolean;
- Indices : List_Id := No_List;
+ Indexes : List_Id := No_List;
Flist : Node_Id := Empty) return List_Id;
-- This recursive routine returns a list of statements containing the
-- loops and assignments that are needed for the expansion of the array
--
-- Scalar_Comp is True if the component type of the aggregate is scalar.
--
- -- Indices is the current list of expressions used to index the
+ -- Indexes is the current list of expressions used to index the
-- object we are writing into.
--
-- Flist is an expression representing the finalization list on which
Index : Node_Id;
Into : Node_Id;
Scalar_Comp : Boolean;
- Indices : List_Id := No_List;
+ Indexes : List_Id := No_List;
Flist : Node_Id := Empty) return List_Id
is
Loc : constant Source_Ptr := Sloc (N);
-- N to Build_Loop contains no sub-aggregates, then this function
-- returns the assignment statement:
--
- -- Into (Indices, Ind) := Expr;
+ -- Into (Indexes, Ind) := Expr;
--
-- Otherwise we call Build_Code recursively
--
-- This routine returns the for loop statement
--
-- for J in Index_Base'(L) .. Index_Base'(H) loop
- -- Into (Indices, J) := Expr;
+ -- Into (Indexes, J) := Expr;
-- end loop;
--
-- Otherwise we call Build_Code recursively.
-- J : Index_Base := L;
-- while J < H loop
-- J := Index_Base'Succ (J);
- -- Into (Indices, J) := Expr;
+ -- Into (Indexes, J) := Expr;
-- end loop;
--
-- Otherwise we call Build_Code recursively
F : Entity_Id;
A : Node_Id;
- New_Indices : List_Id;
+ New_Indexes : List_Id;
Indexed_Comp : Node_Id;
Expr_Q : Node_Id;
Comp_Type : Entity_Id := Empty;
-- Start of processing for Gen_Assign
begin
- if No (Indices) then
- New_Indices := New_List;
+ if No (Indexes) then
+ New_Indexes := New_List;
else
- New_Indices := New_Copy_List_Tree (Indices);
+ New_Indexes := New_Copy_List_Tree (Indexes);
end if;
- Append_To (New_Indices, Ind);
+ Append_To (New_Indexes, Ind);
if Present (Flist) then
F := New_Copy_Tree (Flist);
Index => Next_Index (Index),
Into => Into,
Scalar_Comp => Scalar_Comp,
- Indices => New_Indices,
+ Indexes => New_Indexes,
Flist => F));
end if;
Checks_Off
(Make_Indexed_Component (Loc,
Prefix => New_Copy_Tree (Into),
- Expressions => New_Indices));
+ Expressions => New_Indexes));
Set_Assignment_OK (Indexed_Comp);
Comp_Type := Component_Type (Etype (N));
pragma Assert (Comp_Type = Ctype); -- AI-287
- elsif Present (Next (First (New_Indices))) then
+ elsif Present (Next (First (New_Indexes))) then
-- Ada 2005 (AI-287): Do nothing in case of default initialized
-- component because we have received the component type in
exit Component_Loop;
- -- Case of a subtype mark
+ -- Case of a subtype mark, identifier or expanded name
- elsif Nkind (Choice) = N_Identifier
+ elsif Is_Entity_Name (Choice)
and then Is_Type (Entity (Choice))
then
Lo := Type_Low_Bound (Etype (Choice));
Comp : Node_Id;
Decl : Node_Id;
Typ : constant Entity_Id := Etype (N);
- Indices : constant List_Id := New_List;
+ Indexes : constant List_Id := New_List;
Num : Int;
Sub_Agg : Node_Id;
Next (Comp);
end loop;
- Append_To (Indices,
+ Append_To (Indexes,
Make_Range (Loc,
Low_Bound => Make_Integer_Literal (Loc, 1),
High_Bound => Make_Integer_Literal (Loc, Num)));
Make_Range (Loc,
Low_Bound => Aggr_Low (D),
High_Bound => Aggr_High (D)),
- Indices);
+ Indexes);
end loop;
end if;
Defining_Identifier => Agg_Type,
Type_Definition =>
Make_Constrained_Array_Definition (Loc,
- Discrete_Subtype_Definitions => Indices,
- Component_Definition =>
+ Discrete_Subtype_Definitions => Indexes,
+ Component_Definition =>
Make_Component_Definition (Loc,
- Aliased_Present => False,
+ Aliased_Present => False,
Subtype_Indication =>
New_Occurrence_Of (Component_Type (Typ), Loc))));
-------------------------
function Safe_Left_Hand_Side (N : Node_Id) return Boolean is
+ function Is_Safe_Index (Indx : Node_Id) return Boolean;
+ -- If the left-hand side includes an indexed component, check that
+ -- the indexes are free of side-effect.
+
+ -------------------
+ -- Is_Safe_Index --
+ -------------------
+
+ function Is_Safe_Index (Indx : Node_Id) return Boolean is
+ begin
+ if Is_Entity_Name (Indx) then
+ return True;
+
+ elsif Nkind (Indx) = N_Integer_Literal then
+ return True;
+
+ elsif Nkind (Indx) = N_Function_Call
+ and then Is_Entity_Name (Name (Indx))
+ and then
+ Has_Pragma_Pure_Function (Entity (Name (Indx)))
+ then
+ return True;
+
+ elsif Nkind (Indx) = N_Type_Conversion
+ and then Is_Safe_Index (Expression (Indx))
+ then
+ return True;
+
+ else
+ return False;
+ end if;
+ end Is_Safe_Index;
+
+ -- Start of processing for Safe_Left_Hand_Side
+
begin
if Is_Entity_Name (N) then
return True;
elsif Nkind (N) = N_Indexed_Component
and then Safe_Left_Hand_Side (Prefix (N))
and then
- (Is_Entity_Name (First (Expressions (N)))
- or else Nkind (First (Expressions (N))) = N_Integer_Literal)
+ Is_Safe_Index (First (Expressions (N)))
then
return True;
+
+ elsif Nkind (N) = N_Unchecked_Type_Conversion then
+ return Safe_Left_Hand_Side (Expression (N));
+
else
return False;
end if;
Index => First_Index (Typ),
Into => Target,
Scalar_Comp => Is_Scalar_Type (Component_Type (Typ)),
- Indices => No_List,
+ Indexes => No_List,
Flist => Flist);
end if;
end Late_Expansion;
* Pragma Interface_Name::
* Pragma Interrupt_Handler::
* Pragma Interrupt_State::
+* Pragma Invariant::
* Pragma Keep_Names::
* Pragma License::
* Pragma Link_With::
* Pragma Interface_Name::
* Pragma Interrupt_Handler::
* Pragma Interrupt_State::
+* Pragma Invariant::
* Pragma Keep_Names::
* Pragma License::
* Pragma Link_With::
with an application's runtime behavior in the cases of the synchronous signals,
and in the case of the signal used to implement the @code{abort} statement.
+@node Pragma Invariant
+@unnumberedsec Pragma Invariant
+@findex Invariant
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma Invariant
+ ([Entity =>] private_type_LOCAL_NAME,
+ [Check =>] EXPRESSION
+ [,[Message =>] String_Expression]);
+@end smallexample
+
+@noindent
+This pragma provides exactly the same capabilities as the Invariant aspect
+defined in AI05-0146-1, and in the Ada 2012 Reference Manual. The Invariant
+aspect is fully implemented in Ada 2012 mode, but since it requires the use
+of the aspect syntax, which is not available exception in 2012 mode, it is
+not possible to use the Invariant aspect in earlier versions of Ada. However
+the Invariant pragma may be used in any version of Ada.
+
+The pragma must appear within the visible part of the package specification,
+after the type to which its Entity argument appears. As with the Invariant
+aspect, the Check expression is not analyzed until the end of the visible
+part of the package, so it may contain forward references. The Message
+argument, if present, provides the exception message used if the invariant
+is violated. If no Message parameter is provided, a default message that
+identifies the line on which the pragma appears is used.
+
+It is permissible to have multiple Invariants for the same type entity, in
+which case they are and'ed together. It is permissible to use this pragma
+in Ada 2012 mode, but you cannot have both an invariant aspect and an
+invariant pragma for the same entity.
+
+For further details on the use of this pragma, see the Ada 2012 documentation
+of the Invariant aspect.
+
@node Pragma Keep_Names
@unnumberedsec Pragma Keep_Names
@findex Keep_Names
OSDN Git Service
