aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRobert Dewar <dewar@adacore.com>2014-02-19 10:32:17 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2014-02-19 11:32:17 +0100
commit82d4f39092f2326e7097edff2ddbfb3a4516c86e (patch)
tree4ef5d203fb9a75b2440f6fd6a287a91a74f0985a
parentdd2bf554e085d52c64d9596bc4843751e082804b (diff)
downloadgcc-82d4f39092f2326e7097edff2ddbfb3a4516c86e.zip
gcc-82d4f39092f2326e7097edff2ddbfb3a4516c86e.tar.gz
gcc-82d4f39092f2326e7097edff2ddbfb3a4516c86e.tar.bz2
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
-rw-r--r--gcc/ada/ChangeLog5
-rw-r--r--gcc/ada/exp_attr.adb2
-rw-r--r--gcc/ada/exp_ch5.adb2
-rw-r--r--gcc/ada/par-ch9.adb6
-rw-r--r--gcc/ada/sem_ch13.adb39
-rw-r--r--gcc/ada/sem_ch13.ads54
-rw-r--r--gcc/ada/sem_ch5.adb2
-rw-r--r--gcc/ada/sem_util.adb63
-rw-r--r--gcc/ada/sem_util.ads10
9 files changed, 101 insertions, 82 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a069df8..478b5ff 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 683233c..21472b6 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -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 |
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 37ce6f4..3afd2bd 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -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"
diff --git a/gcc/ada/par-ch9.adb b/gcc/ada/par-ch9.adb
index da7d76d..d2aeb5a 100644
--- a/gcc/ada/par-ch9.adb
+++ b/gcc/ada/par-ch9.adb
@@ -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;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 97715ca..23dba37 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -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);
diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads
index d99d579..222ae06 100644
--- a/gcc/ada/sem_ch13.ads
+++ b/gcc/ada/sem_ch13.ads
@@ -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;
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 6155939..02a7c99 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -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;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index b870018..ceef8fa 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index e06c157..139f6d6 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -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;