+2014-02-19 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <dewar@adacore.com>
* exp_attr.adb (Expand_Min_Max_Attribute): New procedure
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,
Aspect_Interrupt_Priority,
Aspect_Invariant, -- GNAT
Aspect_Iterator_Element,
+ Aspect_Iterable, -- GNAT
Aspect_Link_Name,
Aspect_Linker_Section, -- GNAT
Aspect_Machine_Radix,
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,
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,
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,
when Attribute_Constant_Indexing |
Attribute_Default_Iterator |
Attribute_Implicit_Dereference |
+ Attribute_Iterable |
Attribute_Iterator_Element |
Attribute_Variable_Indexing =>
null;
-- 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".
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
+ -- <original loop statements>
+ -- 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 --
-----------------------------
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
Attribute_Default_Iterator |
Attribute_Implicit_Dereference |
Attribute_Iterator_Element |
+ Attribute_Iterable |
Attribute_Variable_Indexing =>
Error_Msg_N ("illegal attribute", N);
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.
Aspect_Iterator_Element =>
Analyze (Expression (ASN));
+ when Aspect_Iterable =>
+ Validate_Iterable_Aspect (E, ASN);
+
when others =>
null;
end case;
Aspect_Dispatching_Domain |
Aspect_External_Tag |
Aspect_Input |
+ Aspect_Iterable |
Aspect_Iterator_Element |
Aspect_Machine_Radix |
Aspect_Object_Size |
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 --
----------------------
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 |
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 --
-----------------------------------
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;
-- 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
("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
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 --
----------------------------------
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 --
-----------------------
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);
-- 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.
-- 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
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 + $;
Attribute_Integer_Value,
Attribute_Invalid_Value,
Attribute_Iterator_Element,
+ Attribute_Iterable,
Attribute_Large,
Attribute_Last,
Attribute_Last_Bit,
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;
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