FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

par-ch9.adb, [...]: Minor reformatting.

Browse source 
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 2014-02-19 10:32:17 +00:00 • committed by Arnaud Charlet
parent dd2bf554e0
commit 82d4f39092
9 changed files with 101 additions and 82 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
gcc/ada/ChangeLog
View file

@ -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

2
gcc/ada/exp_attr.adb
View file

@ -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 |

2
gcc/ada/exp_ch5.adb
View file

@ -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"

4
gcc/ada/par-ch9.adb
View file

@ -149,8 +149,8 @@ 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)));

29
gcc/ada/sem_ch13.adb
View file

@ -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;
@ -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);

54
gcc/ada/sem_ch13.ads
View file

@ -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;

43
gcc/ada/sem_util.adb
View file

@ -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;
@ -9336,6 +9337,7 @@ 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;
-- Call to an indexing aspect
@ -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.
-- 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
-- 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;
@ -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,8 +9447,7 @@ package body Sem_Util is
return False;
elsif Nkind_In
(Nkind (Parent (Par)),
N_Function_Call,
(Nkind (Parent (Par)), N_Function_Call,
N_Procedure_Call_Statement,
N_Entry_Call_Statement)
then
@ -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

10
gcc/ada/sem_util.ads
View file

@ -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;