diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a069df867ed..478b5fffd8d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2014-02-19 Robert Dewar + + * 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 * style.adb (Missing_Overriding): Warning does not apply in diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 683233c257a..21472b65203 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 37ce6f4efeb..3afd2bd7cc6 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 da7d76d573a..d2aeb5a797a 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 97715ca5d38..23dba37de8f 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 d99d57947c1..222ae06c6a8 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 6155939b473..02a7c995784 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 b8700189631..ceef8fab448 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 e06c1572c48..139f6d6f757 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;