+2014-02-19 Robert Dewar <dewar@adacore.com>
+
+ * par-ch9.adb, exp_ch5.adb, sem_ch5.adb, exp_attr.adb, sem_util.adb,
+ sem_util.ads, sem_ch13.adb, sem_ch13.ads: Minor reformatting.
+
2014-02-19 Ed Schonberg <schonberg@adacore.com>
* style.adb (Missing_Overriding): Warning does not apply in
case Id is
- -- Attributes related to Ada 2012 iterators (placeholder ???)
+ -- Attributes related to Ada 2012 iterators
when Attribute_Constant_Indexing |
Attribute_Default_Iterator |
-- might be filled with components from child types).
procedure Expand_Formal_Container_Loop (Typ : Entity_Id; N : Node_Id);
+ -- Use the primitives specified in an Iterable aspect to expand a loop
+ -- over a so-called formal container, primarily for SPARK usage.
procedure Expand_Iterator_Loop (N : Node_Id);
-- Expand loop over arrays and containers that uses the form "for X of C"
-- null statement, so if a parsing error produces an empty list,
-- patch it now.
- if
- No (First (Statements (Handled_Statement_Sequence (Task_Node))))
+ if No (First (Statements
+ (Handled_Statement_Sequence (Task_Node))))
then
Set_Statements (Handled_Statement_Sequence (Task_Node),
- New_List (Make_Null_Statement (Token_Ptr)));
+ New_List (Make_Null_Statement (Token_Ptr)));
end if;
end if;
when Attribute_Iterable =>
Analyze (Expr);
+
if Nkind (Expr) /= N_Aggregate then
Error_Msg_N ("aspect Iterable must be an aggregate", Expr);
end if;
if not Is_Entity_Name (Expression (Assoc)) then
Error_Msg_N ("value must be a function", Assoc);
end if;
+
Next (Assoc);
end loop;
end;
------------------------------
procedure Validate_Iterable_Aspect (Typ : Entity_Id; ASN : Node_Id) is
- Scop : constant Entity_Id := Scope (Typ);
- Assoc : Node_Id;
- Expr : Node_Id;
+ Scop : constant Entity_Id := Scope (Typ);
+ Assoc : Node_Id;
+ Expr : Node_Id;
- Prim : Node_Id;
- Cursor : Entity_Id;
+ Prim : Node_Id;
+ Cursor : Entity_Id;
First_Id : Entity_Id;
Next_Id : Entity_Id;
procedure Check_Signature (Op : Entity_Id; Num_Formals : Positive);
-- Verify that primitive has two parameters of the proper types.
+ ---------------------
+ -- Check_Signature --
+ ---------------------
+
procedure Check_Signature (Op : Entity_Id; Num_Formals : Positive) is
F1, F2 : Entity_Id;
end if;
F1 := First_Formal (Op);
- if No (F1)
- or else Etype (F1) /= Typ
- then
+
+ if No (F1) or else Etype (F1) /= Typ then
Error_Msg_N ("first parameter must be container type", Op);
end if;
else
F2 := Next_Formal (F1);
- if No (F2)
- or else Etype (F2) /= Cursor
- then
+
+ if No (F2) or else Etype (F2) /= Cursor then
Error_Msg_N ("second parameter must be cursor", Op);
end if;
end if;
end Check_Signature;
+ -- Start of processing for Validate_Iterable_Aspect
+
begin
- -- There must be a cursor type declared in the same package.
+ -- There must be a cursor type declared in the same package
declare
E : Entity_Id;
begin
Cursor := Empty;
+
E := First_Entity (Scop);
while Present (E) loop
- if Chars (E) = Name_Cursor
- and then Is_Type (E)
- then
+ if Chars (E) = Name_Cursor and then Is_Type (E) then
Cursor := E;
exit;
end if;
end if;
Prim := First (Choices (Assoc));
+
if Nkind (Prim) /= N_Identifier
or else Present (Next (Prim))
then
elsif Chars (Prim) = Name_First then
First_Id := Entity (Expr);
Check_Signature (First_Id, 1);
+
if Etype (First_Id) /= Cursor then
Error_Msg_NE ("First must return Cursor", Expr, First_Id);
end if;
elsif Chars (Prim) = Name_Next then
Next_Id := Entity (Expr);
Check_Signature (Next_Id, 2);
+
if Etype (Next_Id) /= Cursor then
Error_Msg_NE ("Next must return Cursor", Expr, First_Id);
end if;
elsif Chars (Prim) = Name_Has_Element then
Has_Element_Id := Entity (Expr);
+
if Etype (Has_Element_Id) /= Standard_Boolean then
Error_Msg_NE
("Has_Element must return Boolean", Expr, First_Id);
-- Esize and RM_Size are reset to the allowed minimum value in T.
function Rep_Item_Too_Early (T : Entity_Id; N : Node_Id) return Boolean;
- -- Called at the start of processing a representation clause or a
- -- representation pragma. Used to check that the representation item
- -- is not being applied to an incomplete type or to a generic formal
- -- type or a type derived from a generic formal type. Returns False if
- -- no such error occurs. If this error does occur, appropriate error
- -- messages are posted on node N, and True is returned.
+ -- Called at start of processing a representation clause/pragma. Used to
+ -- check that the representation item is not being applied to an incomplete
+ -- type or to a generic formal type or a type derived from a generic formal
+ -- type. Returns False if no such error occurs. If this error does occur,
+ -- appropriate error messages are posted on node N, and True is returned.
function Rep_Item_Too_Late
(T : Entity_Id;
N : Node_Id;
FOnly : Boolean := False) return Boolean;
-- Called at the start of processing a representation clause or a
- -- representation pragma. Used to check that a representation item
- -- for entity T does not appear too late (according to the rules in
- -- RM 13.1(9) and RM 13.1(10)). N is the associated node, which in
- -- the pragma case is the pragma or representation clause itself, used
- -- for placing error messages if the item is too late.
+ -- representation pragma. Used to check that a representation item for
+ -- entity T does not appear too late (according to the rules in RM 13.1(9)
+ -- and RM 13.1(10)). N is the associated node, which in the pragma case
+ -- is the pragma or representation clause itself, used for placing error
+ -- messages if the item is too late.
--
-- Fonly is a flag that causes only the freezing rule (para 9) to be
- -- applied, and the tests of para 10 are skipped. This is appropriate
- -- for both subtype related attributes (Alignment and Size) and for
- -- stream attributes, which, although certainly not subtype related
- -- attributes, clearly should not be subject to the para 10 restrictions
- -- (see AI95-00137). Similarly, we also skip the para 10 restrictions for
+ -- applied, and the tests of para 10 are skipped. This is appropriate for
+ -- both subtype related attributes (Alignment and Size) and for stream
+ -- attributes, which, although certainly not subtype related attributes,
+ -- clearly should not be subject to the para 10 restrictions (see
+ -- AI95-00137). Similarly, we also skip the para 10 restrictions for
-- the Storage_Size case where they also clearly do not apply, and for
-- Stream_Convert which is in the same category as the stream attributes.
--
- -- If the rep item is too late, an appropriate message is output and
- -- True is returned, which is a signal that the caller should abandon
- -- processing for the item. If the item is not too late, then False
- -- is returned, and the caller can continue processing the item.
+ -- If the rep item is too late, an appropriate message is output and True
+ -- is returned, which is a signal that the caller should abandon processing
+ -- for the item. If the item is not too late, then False is returned, and
+ -- the caller can continue processing the item.
--
-- If no error is detected, this call also as a side effect links the
-- representation item onto the head of the representation item chain
-- (referenced by the First_Rep_Item field of the entity).
--
- -- Note: Rep_Item_Too_Late must be called with the underlying type in
- -- the case of a private or incomplete type. The protocol is to first
- -- check for Rep_Item_Too_Early using the initial entity, then take the
- -- underlying type, then call Rep_Item_Too_Late on the result.
+ -- Note: Rep_Item_Too_Late must be called with the underlying type in the
+ -- case of a private or incomplete type. The protocol is to first check for
+ -- Rep_Item_Too_Early using the initial entity, then take the underlying
+ -- type, then call Rep_Item_Too_Late on the result.
--
-- Note: Calls to Rep_Item_Too_Late are ignored for the case of attribute
-- definition clauses which have From_Aspect_Specification set. This is
procedure Validate_Iterable_Aspect (Typ : Entity_Id; ASN : Node_Id);
-- For SPARK 2014 formal containers. The expression has the form of an
- -- aggregate, and each entry must denote a function with the proper
- -- syntax for First, Next, and Has_Element. Optionally an Element primitive
- -- may also be defined.
+ -- aggregate, and each entry must denote a function with the proper syntax
+ -- for First, Next, and Has_Element. Optionally an Element primitive may
+ -- also be defined.
+
end Sem_Ch13;
else
Error_Msg_NE
("\to iterate directly over the elements of a container, "
- & "write `of &`", Name (N), Original_Node (Name (N)));
+ & "write `of &`", Name (N), Original_Node (Name (N)));
end if;
end if;
is
Funcs : constant Node_Id := Find_Value_Of_Aspect (Typ, Aspect_Iterable);
Assoc : Node_Id;
+
begin
if No (Funcs) then
return Empty;
---------------------------
function Is_Container_Element (Exp : Node_Id) return Boolean is
- Loc : constant Source_Ptr := Sloc (Exp);
- Pref : constant Node_Id := Prefix (Exp);
- Call : Node_Id;
+ Loc : constant Source_Ptr := Sloc (Exp);
+ Pref : constant Node_Id := Prefix (Exp);
+
+ Call : Node_Id;
-- Call to an indexing aspect
Cont_Typ : Entity_Id;
Indexing : Entity_Id;
Is_Const : Boolean;
-- Indicates that constant indexing is used, and the element is thus
- -- a constant
+ -- a constant.
- Ref_Typ : Entity_Id;
- -- The reference type returned by the indexing operation.
+ Ref_Typ : Entity_Id;
+ -- The reference type returned by the indexing operation
begin
-- If C is a container, in a context that imposes the element type of
-- that container, the indexing notation C (X) is rewritten as:
- -- Indexing (C, X).Discr.all
+
+ -- Indexing (C, X).Discr.all
+
-- where Indexing is one of the indexing aspects of the container.
-- If the context does not require a reference, the construct can be
- -- rewritten as Element (C, X).
- -- First, verify that the construct has the proper form.
+ -- rewritten as
+
+ -- Element (C, X)
+
+ -- First, verify that the construct has the proper form
if not Expander_Active then
return False;
return False;
else
- Call := Prefix (Pref);
- Ref_Typ := Etype (Call);
+ Call := Prefix (Pref);
+ Ref_Typ := Etype (Call);
end if;
if not Has_Implicit_Dereference (Ref_Typ)
return False;
end if;
- -- Retrieve type of container object, and its iterator aspects.
+ -- Retrieve type of container object, and its iterator aspects
Cont_Typ := Etype (First (Parameter_Associations (Call)));
- Indexing :=
- Find_Value_Of_Aspect (Cont_Typ, Aspect_Constant_Indexing);
+ Indexing := Find_Value_Of_Aspect (Cont_Typ, Aspect_Constant_Indexing);
Is_Const := False;
+
if No (Indexing) then
- -- Container should have at least one indexing operation.
+ -- Container should have at least one indexing operation
return False;
-- This may be a variable indexing operation
- Indexing :=
- Find_Value_Of_Aspect (Cont_Typ, Aspect_Variable_Indexing);
+ Indexing := Find_Value_Of_Aspect (Cont_Typ, Aspect_Variable_Indexing);
+
if No (Indexing)
or else Entity (Name (Call)) /= Entity (Indexing)
then
end if;
Elem_Typ := Find_Value_Of_Aspect (Cont_Typ, Aspect_Iterator_Element);
- if No (Elem_Typ)
- or else Entity (Elem_Typ) /= Etype (Exp)
- then
+
+ if No (Elem_Typ) or else Entity (Elem_Typ) /= Etype (Exp) then
return False;
end if;
return False;
elsif Nkind_In
- (Nkind (Parent (Par)),
- N_Function_Call,
- N_Procedure_Call_Statement,
- N_Entry_Call_Statement)
+ (Nkind (Parent (Par)), N_Function_Call,
+ N_Procedure_Call_Statement,
+ N_Entry_Call_Statement)
then
-- Check that the element is not part of an actual for an
-- in-out parameter.
F := First_Formal (Entity (Name (Parent (Par))));
A := First (Parameter_Associations (Parent (Par)));
while Present (F) loop
- if A = Par
- and then Ekind (F) /= E_In_Parameter
- then
+ if A = Par and then Ekind (F) /= E_In_Parameter then
return False;
end if;
end loop;
end;
- -- in_parameter in a call: element is not modified.
+ -- E_In_Parameter in a call: element is not modified.
exit;
end if;
end if;
-- The expression has the proper form and the context requires the
- -- element type. Retrieve the Element function of the container, and
+ -- element type. Retrieve the Element function of the container and
-- rewrite the construct as a call to it.
declare
else
Rewrite (Exp,
Make_Function_Call (Loc,
- Name => New_Occurrence_Of (Node (Op), Loc),
+ Name => New_Occurrence_Of (Node (Op), Loc),
Parameter_Associations => Parameter_Associations (Call)));
Analyze_And_Resolve (Exp, Entity (Elem_Typ));
return True;
function Is_Container_Element (Exp : Node_Id) return Boolean;
-- This routine recognizes expressions that denote an element of one of
-- the predefined containers, when the source only contains an indexing
- -- operation and an implicit dereference is inserted by the compiler. In
- -- the absence of this optimization, the indexing creates a temporary
+ -- operation and an implicit dereference is inserted by the compiler.
+ -- In the absence of this optimization, the indexing creates a temporary
-- controlled cursor that sets the tampering bit of the container, and
-- restricts the use of the convenient notation C (X) to contexts that
- -- do not check the tampering bit (e.g. C.Include (X, C (Y)).
- -- Exp is an explicit dereference. The transformation applies when it
- -- has the form F (X).Discr.all.
+ -- do not check the tampering bit (e.g. C.Include (X, C (Y)). Exp is an
+ -- explicit dereference. The transformation applies when it has the form
+ -- F (X).Discr.all.
function Is_Controlling_Limited_Procedure
(Proc_Nam : Entity_Id) return Boolean;
git://gcc.gnu.org / gcc.git / commitdiff