par-ch9.adb, [...]: Minor reformatting.
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. From-SVN: r207882
This commit is contained in:
Robert Dewar
Arnaud Charlet
parent
dd2bf554e0
commit
82d4f39092
9 changed files with 101 additions and 82 deletions
|
|
@ -1,3 +1,8 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -1346,7 +1346,7 @@ package body Exp_Attr is
|
|||
|
||||
case Id is
|
||||
|
||||
-- Attributes related to Ada 2012 iterators (placeholder ???)
|
||||
-- Attributes related to Ada 2012 iterators
|
||||
|
||||
when Attribute_Constant_Indexing |
|
||||
Attribute_Default_Iterator |
|
||||
|
|
|
|||
|
|
@ -104,6 +104,8 @@ package body Exp_Ch5 is
|
|||
-- 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"
|
||||
|
|
|
|||
|
|
@ -149,11 +149,11 @@ package body Ch9 is
|
|||
-- 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;
|
||||
|
||||
|
|
|
|||
|
|
@ -4291,6 +4291,7 @@ package body Sem_Ch13 is
|
|||
|
||||
when Attribute_Iterable =>
|
||||
Analyze (Expr);
|
||||
|
||||
if Nkind (Expr) /= N_Aggregate then
|
||||
Error_Msg_N ("aspect Iterable must be an aggregate", Expr);
|
||||
end if;
|
||||
|
|
@ -4304,6 +4305,7 @@ package body Sem_Ch13 is
|
|||
if not Is_Entity_Name (Expression (Assoc)) then
|
||||
Error_Msg_N ("value must be a function", Assoc);
|
||||
end if;
|
||||
|
||||
Next (Assoc);
|
||||
end loop;
|
||||
end;
|
||||
|
|
@ -11269,12 +11271,12 @@ package body Sem_Ch13 is
|
|||
------------------------------
|
||||
|
||||
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;
|
||||
|
|
@ -11284,6 +11286,10 @@ package body Sem_Ch13 is
|
|||
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;
|
||||
|
||||
|
|
@ -11293,9 +11299,8 @@ package body Sem_Ch13 is
|
|||
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;
|
||||
|
||||
|
|
@ -11306,9 +11311,8 @@ package body Sem_Ch13 is
|
|||
|
||||
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;
|
||||
|
||||
|
|
@ -11318,19 +11322,20 @@ package body Sem_Ch13 is
|
|||
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;
|
||||
|
|
@ -11362,6 +11367,7 @@ package body Sem_Ch13 is
|
|||
end if;
|
||||
|
||||
Prim := First (Choices (Assoc));
|
||||
|
||||
if Nkind (Prim) /= N_Identifier
|
||||
or else Present (Next (Prim))
|
||||
then
|
||||
|
|
@ -11370,6 +11376,7 @@ package body Sem_Ch13 is
|
|||
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;
|
||||
|
|
@ -11377,12 +11384,14 @@ package body Sem_Ch13 is
|
|||
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);
|
||||
|
|
|
|||
|
|
@ -133,46 +133,45 @@ package Sem_Ch13 is
|
|||
-- 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
|
||||
|
|
@ -328,7 +327,8 @@ package Sem_Ch13 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;
|
||||
|
|
|
|||
|
|
@ -1912,7 +1912,7 @@ package body Sem_Ch5 is
|
|||
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;
|
||||
|
||||
|
|
|
|||
|
|
@ -6629,6 +6629,7 @@ package body Sem_Util is
|
|||
is
|
||||
Funcs : constant Node_Id := Find_Value_Of_Aspect (Typ, Aspect_Iterable);
|
||||
Assoc : Node_Id;
|
||||
|
||||
begin
|
||||
if No (Funcs) then
|
||||
return Empty;
|
||||
|
|
@ -9334,9 +9335,10 @@ package body Sem_Util is
|
|||
---------------------------
|
||||
|
||||
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;
|
||||
|
|
@ -9348,19 +9350,24 @@ package body Sem_Util is
|
|||
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;
|
||||
|
|
@ -9372,8 +9379,8 @@ package body Sem_Util is
|
|||
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)
|
||||
|
|
@ -9383,15 +9390,15 @@ package body Sem_Util is
|
|||
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;
|
||||
|
||||
|
|
@ -9399,8 +9406,8 @@ package body Sem_Util is
|
|||
|
||||
-- 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
|
||||
|
|
@ -9412,9 +9419,8 @@ package body Sem_Util is
|
|||
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;
|
||||
|
||||
|
|
@ -9441,10 +9447,9 @@ package body Sem_Util is
|
|||
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.
|
||||
|
|
@ -9457,9 +9462,7 @@ package body Sem_Util is
|
|||
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;
|
||||
|
||||
|
|
@ -9468,7 +9471,7 @@ package body Sem_Util is
|
|||
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;
|
||||
|
|
@ -9479,7 +9482,7 @@ package body Sem_Util is
|
|||
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
|
||||
|
|
@ -9498,7 +9501,7 @@ package body Sem_Util is
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -1111,13 +1111,13 @@ package Sem_Util is
|
|||
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;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue