diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d456c84c9135..a069df867ed9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2014-02-19 Ed Schonberg + + * style.adb (Missing_Overriding): Warning does not apply in + language versions prior to Ada 2005. + * snames.ads-tmpl: Add Name_Iterable and Attribute_Iterable. + * sem_attr.adb: Add Attribute_Iterable where needed. + * exp_attr.adb: ditto. + * exp_ch5.adb (Expand_Formal_Container_Loop): New procedure to + handle loops and quantified expressions over types that have an + iterable aspect. Called from Expand_Iterator_Loop. + * sem_ch5.adb (Analyze_Iterator_Specification): Recognize types + with Iterable aspect. + * sem_ch13.adb (Validate_Iterable_Aspect): Verify that the + subprograms specified in the Iterable aspect have the proper + signature involving container and cursor. + (Check_Aspect_At_Freeze_Point): Analyze value of iterable aspect. + * sem_ch13.ads (Validate_Iterable_Aspect): New subprogram. + * sem_util.ads, sem_util.adb (Get_Iterable_Type_Primitive): + New procedure to retrieve one of the primitives First, Last, + or Has_Element, from the value of the iterable aspect of a + formal container. + (Is_Container_Element): Predicate to recognize expressions + that denote an element of one of the predefined containers, + for possible optimization. This subprogram is not currently + used, pending ARG discussions on the legality of the proposed + optimization. Worth preserving for eventual use. + (Is_Iterator): Recognize formal container types. + * aspects.ads, aspects.adb: Add Aspect_Iterable where needed. + 2014-02-19 Robert Dewar * exp_attr.adb (Expand_Min_Max_Attribute): New procedure diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index cff2b811c626..e34c9faad014 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -514,6 +514,7 @@ package body Aspects is Aspect_Interrupt_Handler => Aspect_Interrupt_Handler, Aspect_Interrupt_Priority => Aspect_Priority, Aspect_Invariant => Aspect_Invariant, + Aspect_Iterable => Aspect_Iterable, Aspect_Iterator_Element => Aspect_Iterator_Element, Aspect_Link_Name => Aspect_Link_Name, Aspect_Linker_Section => Aspect_Linker_Section, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index e8d3a1dc73d6..be39625fb938 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -102,6 +102,7 @@ package Aspects is Aspect_Interrupt_Priority, Aspect_Invariant, -- GNAT Aspect_Iterator_Element, + Aspect_Iterable, -- GNAT Aspect_Link_Name, Aspect_Linker_Section, -- GNAT Aspect_Machine_Radix, @@ -325,6 +326,7 @@ package Aspects is Aspect_Input => Name, Aspect_Interrupt_Priority => Expression, Aspect_Invariant => Expression, + Aspect_Iterable => Expression, Aspect_Iterator_Element => Name, Aspect_Link_Name => Expression, Aspect_Linker_Section => Expression, @@ -423,6 +425,7 @@ package Aspects is Aspect_Interrupt_Priority => Name_Interrupt_Priority, Aspect_Invariant => Name_Invariant, Aspect_Iterator_Element => Name_Iterator_Element, + Aspect_Iterable => Name_Iterable, Aspect_Link_Name => Name_Link_Name, Aspect_Linker_Section => Name_Linker_Section, Aspect_Lock_Free => Name_Lock_Free, @@ -628,6 +631,7 @@ package Aspects is Aspect_Interrupt_Handler => Always_Delay, Aspect_Interrupt_Priority => Always_Delay, Aspect_Invariant => Always_Delay, + Aspect_Iterable => Always_Delay, Aspect_Iterator_Element => Always_Delay, Aspect_Link_Name => Always_Delay, Aspect_Linker_Section => Always_Delay, diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 503a1ae3a21b..683233c257ac 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1351,6 +1351,7 @@ package body Exp_Attr is when Attribute_Constant_Indexing | Attribute_Default_Iterator | Attribute_Implicit_Dereference | + Attribute_Iterable | Attribute_Iterator_Element | Attribute_Variable_Indexing => null; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index a65365b2595d..37ce6f4efeba 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -103,6 +103,8 @@ package body Exp_Ch5 is -- clause (this last case is required because holes in the tagged type -- might be filled with components from child types). + procedure Expand_Formal_Container_Loop (Typ : Entity_Id; N : Node_Id); + procedure Expand_Iterator_Loop (N : Node_Id); -- Expand loop over arrays and containers that uses the form "for X of C" -- with an optional subtype mark, or "for Y in C". @@ -2651,6 +2653,85 @@ package body Exp_Ch5 is Adjust_Condition (Condition (N)); end Expand_N_Exit_Statement; + ---------------------------------- + -- Expand_Formal_Container_Loop -- + ---------------------------------- + + procedure Expand_Formal_Container_Loop (Typ : Entity_Id; N : Node_Id) is + Isc : constant Node_Id := Iteration_Scheme (N); + I_Spec : constant Node_Id := Iterator_Specification (Isc); + Cursor : constant Entity_Id := Defining_Identifier (I_Spec); + Container : constant Node_Id := Entity (Name (I_Spec)); + Stats : constant List_Id := Statements (N); + Loc : constant Source_Ptr := Sloc (N); + + First_Op : constant Entity_Id := + Get_Iterable_Type_Primitive (Typ, Name_First); + Next_Op : constant Entity_Id := + Get_Iterable_Type_Primitive (Typ, Name_Next); + Has_Element_Op : constant Entity_Id := + Get_Iterable_Type_Primitive (Typ, Name_Has_Element); + + Advance : Node_Id; + Init : Node_Id; + New_Loop : Node_Id; + + begin + -- The expansion resembles the one for Ada containers, but the + -- primitives mention the the domain of iteration explicitly, and + -- First applied to the container yields a cursor directly. + + -- Cursor : Cursor_type := First (Container); + -- while Has_Element (Cursor, Container) loop + -- + -- Cursor := Next (Container, Cursor); + -- end loop; + + Init := + Make_Object_Declaration (Loc, + Defining_Identifier => Cursor, + Object_Definition => New_Occurrence_Of (Etype (First_Op), Loc), + Expression => + Make_Function_Call (Loc, + Name => New_Occurrence_Of (First_Op, Loc), + Parameter_Associations => + New_List (New_Occurrence_Of (Container, Loc)))); + + Set_Ekind (Cursor, E_Variable); + + Insert_Action (N, Init); + + Advance := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Cursor, Loc), + Expression => + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Next_Op, Loc), + Parameter_Associations => + New_List + (New_Occurrence_Of (Container, Loc), + New_Occurrence_Of (Cursor, Loc)))); + + Append_To (Stats, Advance); + + New_Loop := + Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Condition => + Make_Function_Call (Loc, + Name => + New_Occurrence_Of (Has_Element_Op, Loc), + Parameter_Associations => + New_List + (New_Reference_To (Container, Loc), + New_Reference_To (Cursor, Loc)))), + Statements => Stats, + End_Label => Empty); + Rewrite (N, New_Loop); + Analyze (New_Loop); + end Expand_Formal_Container_Loop; + ----------------------------- -- Expand_N_Goto_Statement -- ----------------------------- @@ -2966,6 +3047,10 @@ package body Exp_Ch5 is if Is_Array_Type (Container_Typ) then Expand_Iterator_Loop_Over_Array (N); return; + + elsif Has_Aspect (Container_Typ, Aspect_Iterable) then + Expand_Formal_Container_Loop (Container_Typ, N); + return; end if; -- Processing for containers diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 6bebed6a89df..b25bf1726db8 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -2491,6 +2491,7 @@ package body Sem_Attr is Attribute_Default_Iterator | Attribute_Implicit_Dereference | Attribute_Iterator_Element | + Attribute_Iterable | Attribute_Variable_Indexing => Error_Msg_N ("illegal attribute", N); @@ -7472,6 +7473,7 @@ package body Sem_Attr is Attribute_Default_Iterator | Attribute_Implicit_Dereference | Attribute_Iterator_Element | + Attribute_Iterable | Attribute_Variable_Indexing => null; -- Internal attributes used to deal with Ada 2012 delayed aspects. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index ba4427e7e7e4..97715ca5d38f 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1110,6 +1110,9 @@ package body Sem_Ch13 is Aspect_Iterator_Element => Analyze (Expression (ASN)); + when Aspect_Iterable => + Validate_Iterable_Aspect (E, ASN); + when others => null; end case; @@ -1571,6 +1574,7 @@ package body Sem_Ch13 is Aspect_Dispatching_Domain | Aspect_External_Tag | Aspect_Input | + Aspect_Iterable | Aspect_Iterator_Element | Aspect_Machine_Radix | Aspect_Object_Size | @@ -4281,6 +4285,29 @@ package body Sem_Ch13 is end if; end Interrupt_Priority; + -------------- + -- Iterable -- + -------------- + + when Attribute_Iterable => + Analyze (Expr); + if Nkind (Expr) /= N_Aggregate then + Error_Msg_N ("aspect Iterable must be an aggregate", Expr); + end if; + + declare + Assoc : Node_Id; + + begin + Assoc := First (Component_Associations (Expr)); + while Present (Assoc) loop + if not Is_Entity_Name (Expression (Assoc)) then + Error_Msg_N ("value must be a function", Assoc); + end if; + Next (Assoc); + end loop; + end; + ---------------------- -- Iterator_Element -- ---------------------- @@ -8012,6 +8039,20 @@ package body Sem_Ch13 is Analyze (Expression (ASN)); return; + -- Ditto for Iterable, legality checks in Validate_Iterable_Aspect. + + when Aspect_Iterable => + declare + Assoc : Node_Id; + begin + Assoc := First (Component_Associations (Expression (ASN))); + while Present (Assoc) loop + Analyze (Expression (Assoc)); + Next (Assoc); + end loop; + end; + return; + -- Invariant/Predicate take boolean expressions when Aspect_Dynamic_Predicate | @@ -11223,6 +11264,153 @@ package body Sem_Ch13 is end loop; end Validate_Independence; + ------------------------------ + -- Validate_Iterable_Aspect -- + ------------------------------ + + procedure Validate_Iterable_Aspect (Typ : Entity_Id; ASN : Node_Id) is + Scop : constant Entity_Id := Scope (Typ); + Assoc : Node_Id; + Expr : Node_Id; + + Prim : Node_Id; + Cursor : Entity_Id; + + First_Id : Entity_Id; + Next_Id : Entity_Id; + Has_Element_Id : Entity_Id; + Element_Id : Entity_Id; + + procedure Check_Signature (Op : Entity_Id; Num_Formals : Positive); + -- Verify that primitive has two parameters of the proper types. + + procedure Check_Signature (Op : Entity_Id; Num_Formals : Positive) is + F1, F2 : Entity_Id; + + begin + if Scope (Op) /= Current_Scope then + Error_Msg_N ("iterable primitive must be declared in scope", Prim); + end if; + + F1 := First_Formal (Op); + if No (F1) + or else Etype (F1) /= Typ + then + Error_Msg_N ("first parameter must be container type", Op); + end if; + + if Num_Formals = 1 then + if Present (Next_Formal (F1)) then + Error_Msg_N ("First must have a single parameter", Op); + end if; + + else + F2 := Next_Formal (F1); + if No (F2) + or else Etype (F2) /= Cursor + then + Error_Msg_N ("second parameter must be cursor", Op); + end if; + + if Present (Next_Formal (F2)) then + Error_Msg_N ("too many parameters in iterable primitive", Op); + end if; + end if; + end Check_Signature; + + begin + -- 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 + Cursor := E; + exit; + end if; + + Next_Entity (E); + end loop; + + if No (Cursor) then + Error_Msg_N ("Iterable aspect requires a cursor type", ASN); + return; + end if; + end; + + First_Id := Empty; + Next_Id := Empty; + Has_Element_Id := Empty; + + -- Each expression must resolve to a function with the proper signature + + Assoc := First (Component_Associations (Expression (ASN))); + while Present (Assoc) loop + Expr := Expression (Assoc); + Analyze (Expr); + + if not Is_Entity_Name (Expr) + or else Ekind (Entity (Expr)) /= E_Function + then + Error_Msg_N ("this should be a function name", Expr); + end if; + + Prim := First (Choices (Assoc)); + if Nkind (Prim) /= N_Identifier + or else Present (Next (Prim)) + then + Error_Msg_N ("illegal name in association", Prim); + + 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); + end if; + + elsif Chars (Prim) = Name_Element then + Element_Id := Entity (Expr); + Check_Signature (Element_Id, 2); + + else + Error_Msg_N ("invalid name for iterable function", Prim); + end if; + + Next (Assoc); + end loop; + + if No (First_Id) then + Error_Msg_N ("Iterable aspect must have a First primitive", ASN); + + elsif No (Next_Id) then + Error_Msg_N ("Iterable aspect must have a Next primitive", ASN); + + elsif No (Has_Element_Id) then + Error_Msg_N + ("Iterable aspect must have a Has_Element primitive", ASN); + end if; + end Validate_Iterable_Aspect; + ----------------------------------- -- Validate_Unchecked_Conversion -- ----------------------------------- diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index edf106ad3ffa..d99d57947c19 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -325,4 +325,10 @@ package Sem_Ch13 is procedure Inherit_Aspects_At_Freeze_Point (Typ : Entity_Id); -- Given an entity Typ that denotes a derived type or a subtype, this -- routine performs the inheritance of aspects at the freeze point. + + 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. end Sem_Ch13; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index a7cf878b33fe..6155939b4732 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1890,10 +1890,16 @@ package body Sem_Ch5 is -- iterator, typically the result of a call to Iterate. Give a -- useful error message when the name is a container by itself. + -- The type may be a formal container type, which has to have + -- an Iterable aspect detailing the required primitives. + if Is_Entity_Name (Original_Node (Name (N))) and then not Is_Iterator (Typ) then - if not Has_Aspect (Typ, Aspect_Iterator_Element) then + if Has_Aspect (Typ, Aspect_Iterable) then + null; + + elsif not Has_Aspect (Typ, Aspect_Iterator_Element) then Error_Msg_NE ("cannot iterate over&", Name (N), Typ); else @@ -1901,9 +1907,13 @@ package body Sem_Ch5 is ("name must be an iterator, not a container", Name (N)); end if; - Error_Msg_NE - ("\to iterate directly over the elements of a container, " & - "write `of &`", Name (N), Original_Node (Name (N))); + if Has_Aspect (Typ, Aspect_Iterable) then + null; + else + Error_Msg_NE + ("\to iterate directly over the elements of a container, " + & "write `of &`", Name (N), Original_Node (Name (N))); + end if; end if; -- The result type of Iterate function is the classwide type of diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 37e0877a2ba6..b87001896318 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6619,6 +6619,34 @@ package body Sem_Util is end if; end Get_Index_Bounds; + --------------------------------- + -- Get_Iterable_Type_Primitive -- + --------------------------------- + + function Get_Iterable_Type_Primitive + (Typ : Entity_Id; + Nam : Name_Id) return Entity_Id + is + Funcs : constant Node_Id := Find_Value_Of_Aspect (Typ, Aspect_Iterable); + Assoc : Node_Id; + begin + if No (Funcs) then + return Empty; + + else + Assoc := First (Component_Associations (Funcs)); + while Present (Assoc) loop + if Chars (First (Choices (Assoc))) = Nam then + return Entity (Expression (Assoc)); + end if; + + Assoc := Next (Assoc); + end loop; + + return Empty; + end if; + end Get_Iterable_Type_Primitive; + ---------------------------------- -- Get_Library_Unit_Name_string -- ---------------------------------- @@ -9301,6 +9329,183 @@ package body Sem_Util is or else Is_Task_Interface (T)); end Is_Concurrent_Interface; + --------------------------- + -- Is_Container_Element -- + --------------------------- + + 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 + + Cont_Typ : Entity_Id; + -- The type of the container being accessed + + Elem_Typ : Entity_Id; + -- Its element type + + Indexing : Entity_Id; + Is_Const : Boolean; + -- Indicates that constant indexing is used, and the element is thus + -- a constant + + 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 + -- 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. + + if not Expander_Active then + return False; + + elsif Nkind (Pref) /= N_Selected_Component then + return False; + + elsif Nkind (Prefix (Pref)) /= N_Function_Call then + return False; + + else + Call := Prefix (Pref); + Ref_Typ := Etype (Call); + end if; + + if not Has_Implicit_Dereference (Ref_Typ) + or else No (First (Parameter_Associations (Call))) + or else not Is_Entity_Name (Name (Call)) + then + return False; + end if; + + -- 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); + Is_Const := False; + if No (Indexing) then + + -- Container should have at least one indexing operation. + + return False; + + elsif Entity (Name (Call)) /= Entity (Indexing) then + + -- This may be a variable indexing operation + + Indexing := + Find_Value_Of_Aspect (Cont_Typ, Aspect_Variable_Indexing); + if No (Indexing) + or else Entity (Name (Call)) /= Entity (Indexing) + then + return False; + end if; + + else + Is_Const := True; + 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 + return False; + end if; + + -- Check that the expression is not the target of an assignment, in + -- which case the rewriting is not possible. + + if not Is_Const then + declare + Par : Node_Id; + + begin + Par := Exp; + while Present (Par) + loop + if Nkind (Parent (Par)) = N_Assignment_Statement + and then Par = Name (Parent (Par)) + then + return False; + + -- A renaming produces a reference, and the transformation + -- does not apply. + + elsif Nkind (Parent (Par)) = N_Object_Renaming_Declaration then + return False; + + elsif Nkind_In + (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. + + declare + F : Entity_Id; + A : Node_Id; + + begin + 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 + return False; + end if; + + Next_Formal (F); + Next (A); + end loop; + end; + + -- in_parameter in a call: element is not modified. + + exit; + end if; + + Par := Parent (Par); + end loop; + end; + end if; + + -- The expression has the proper form and the context requires the + -- element type. Retrieve the Element function of the container, and + -- rewrite the construct as a call to it. + + declare + Op : Elmt_Id; + + begin + Op := First_Elmt (Primitive_Operations (Cont_Typ)); + while Present (Op) loop + exit when Chars (Node (Op)) = Name_Element; + Next_Elmt (Op); + end loop; + + if No (Op) then + return False; + + else + Rewrite (Exp, + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Node (Op), Loc), + Parameter_Associations => Parameter_Associations (Call))); + Analyze_And_Resolve (Exp, Entity (Elem_Typ)); + return True; + end if; + end; + end Is_Container_Element; + ----------------------- -- Is_Constant_Bound -- ----------------------- @@ -10039,6 +10244,9 @@ package body Sem_Util is elsif not Is_Tagged_Type (Typ) or else not Is_Derived_Type (Typ) then return False; + elsif Present (Find_Value_Of_Aspect (Typ, Aspect_Iterable)) then + return True; + else Collect_Interfaces (Typ, Ifaces_List); diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index d8dfaaaeb5dd..e06c1572c48a 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -818,6 +818,12 @@ package Sem_Util is -- The third argument supplies a source location for constructed nodes -- returned by this function. + function Get_Iterable_Type_Primitive + (Typ : Entity_Id; + Nam : Name_Id) return Entity_Id; + -- Retrieve one of the primitives First, Next, Has_Element, Element from + -- the value of the Iterable aspect of a formal type. + procedure Get_Library_Unit_Name_String (Decl_Node : Node_Id); -- Retrieve the fully expanded name of the library unit declared by -- Decl_Node into the name buffer. @@ -1102,6 +1108,17 @@ package Sem_Util is -- enumeration literal, or an expression composed of constant-bound -- subexpressions which are evaluated by means of standard operators. + 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 + -- 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. + function Is_Controlling_Limited_Procedure (Proc_Nam : Entity_Id) return Boolean; -- Ada 2005 (AI-345): Determine whether Proc_Nam is a primitive procedure diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 69f66472d4d7..7a86c97b1ce0 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -872,6 +872,7 @@ package Snames is Name_Integer_Value : constant Name_Id := N + $; -- GNAT Name_Invalid_Value : constant Name_Id := N + $; -- GNAT Name_Iterator_Element : constant Name_Id := N + $; -- GNAT + Name_Iterable : constant Name_Id := N + $; -- GNAT Name_Large : constant Name_Id := N + $; -- Ada 83 Name_Last : constant Name_Id := N + $; Name_Last_Bit : constant Name_Id := N + $; @@ -1496,6 +1497,7 @@ package Snames is Attribute_Integer_Value, Attribute_Invalid_Value, Attribute_Iterator_Element, + Attribute_Iterable, Attribute_Large, Attribute_Last, Attribute_Last_Bit, diff --git a/gcc/ada/style.adb b/gcc/ada/style.adb index b07e22384781..33e0077e0d21 100644 --- a/gcc/ada/style.adb +++ b/gcc/ada/style.adb @@ -29,6 +29,7 @@ with Csets; use Csets; with Einfo; use Einfo; with Errout; use Errout; with Namet; use Namet; +with Opt; use Opt; with Sinfo; use Sinfo; with Sinput; use Sinput; with Stand; use Stand; @@ -260,10 +261,12 @@ package body Style is begin -- Perform the check on source subprograms and on subprogram instances, - -- because these can be primitives of untagged types. + -- because these can be primitives of untagged types. Note that such + -- indicators were introduced in Ada 2005. if Style_Check_Missing_Overriding and then (Comes_From_Source (N) or else Is_Generic_Instance (E)) + and then Ada_Version >= Ada_2005 then if Nkind (N) = N_Subprogram_Body then Error_Msg_NE -- CODEFIX