+2012-04-02 Yannick Moy <moy@adacore.com>
+
+ * lib-xref-alfa.adb: Code clean up.
+
+2012-04-02 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Analyze_Subprogram_Instantiation): Do not suppress
+ style checks, because the subprogram instance itself may contain
+ violations of syle rules.
+ * style.adb (Missing_Overriding): Check for missing overriding
+ indicator on a subprogram instance.
+
+2012-04-02 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch6.adb (Last_Implicit_Declaration): New routine.
+ (Process_PPCs): Insert the body of _postconditions after the
+ last internally generated declaration. This ensures that actual
+ subtypes created for formal parameters are visible and properly
+ frozen as _postconditions may reference them.
+
2012-04-02 Robert Dewar <dewar@adacore.com>
* einfo.adb (First_Component_Or_Discriminant) Now applies to
elsif T1.Def /= T2.Def then
return T1.Def < T2.Def;
- -- The following should be commented, it sure looks like a test,
- -- but it sits uncommented between the "third test" and the "fourth
- -- test! ??? Shouldn't this in any case be an assertion ???
+ else
+ -- Both entities must be equal at this point
- elsif T1.Key.Ent /= T2.Key.Ent then
- raise Program_Error;
+ pragma Assert (T1.Key.Ent = T2.Key.Ent);
- -- Fourth test: if reference is in same unit as entity definition,
- -- sort first.
+ -- Fourth test: if reference is in same unit as entity definition,
+ -- sort first.
- elsif T1.Key.Lun /= T2.Key.Lun
- and then T1.Ent_Scope_File = T1.Key.Lun
- then
- return True;
+ if T1.Key.Lun /= T2.Key.Lun
+ and then T1.Ent_Scope_File = T1.Key.Lun
+ then
+ return True;
- elsif T1.Key.Lun /= T2.Key.Lun
- and then T2.Ent_Scope_File = T2.Key.Lun
- then
- return False;
+ elsif T1.Key.Lun /= T2.Key.Lun
+ and then T2.Ent_Scope_File = T2.Key.Lun
+ then
+ return False;
- -- Fifth test: if reference is in same unit and same scope as entity
- -- definition, sort first.
+ -- Fifth test: if reference is in same unit and same scope as
+ -- entity definition, sort first.
- elsif T1.Ent_Scope_File = T1.Key.Lun
- and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
- and then T1.Key.Ent_Scope = T1.Key.Ref_Scope
- then
- return True;
+ elsif T1.Ent_Scope_File = T1.Key.Lun
+ and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
+ and then T1.Key.Ent_Scope = T1.Key.Ref_Scope
+ then
+ return True;
- elsif T2.Ent_Scope_File = T2.Key.Lun
- and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
- and then T2.Key.Ent_Scope = T2.Key.Ref_Scope
- then
- return False;
+ elsif T2.Ent_Scope_File = T2.Key.Lun
+ and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
+ and then T2.Key.Ent_Scope = T2.Key.Ref_Scope
+ then
+ return False;
- -- Sixth test: for same entity, sort by reference location unit
+ -- Sixth test: for same entity, sort by reference location unit
- elsif T1.Key.Lun /= T2.Key.Lun then
- return Dependency_Num (T1.Key.Lun) < Dependency_Num (T2.Key.Lun);
+ elsif T1.Key.Lun /= T2.Key.Lun then
+ return Dependency_Num (T1.Key.Lun) <
+ Dependency_Num (T2.Key.Lun);
- -- Seventh test: for same entity, sort by reference location scope
+ -- Seventh test: for same entity, sort by reference location scope
- elsif Get_Scope_Num (T1.Key.Ref_Scope) /=
- Get_Scope_Num (T2.Key.Ref_Scope)
- then
- return Get_Scope_Num (T1.Key.Ref_Scope) <
- Get_Scope_Num (T2.Key.Ref_Scope);
+ elsif Get_Scope_Num (T1.Key.Ref_Scope) /=
+ Get_Scope_Num (T2.Key.Ref_Scope)
+ then
+ return Get_Scope_Num (T1.Key.Ref_Scope) <
+ Get_Scope_Num (T2.Key.Ref_Scope);
- -- Eighth test: order of location within referencing unit
+ -- Eighth test: order of location within referencing unit
- elsif T1.Key.Loc /= T2.Key.Loc then
- return T1.Key.Loc < T2.Key.Loc;
+ elsif T1.Key.Loc /= T2.Key.Loc then
+ return T1.Key.Loc < T2.Key.Loc;
- -- Finally, for two locations at the same address prefer the one that
- -- does NOT have the type 'r', so that a modification or extension
- -- takes preference, when there are more than one reference at the
- -- same location. As a result, in the case of entities that are
- -- in-out actuals, the read reference follows the modify reference.
+ -- Finally, for two locations at the same address prefer the one
+ -- that does NOT have the type 'r', so that a modification or
+ -- extension takes preference, when there are more than one
+ -- reference at the same location. As a result, in the case of
+ -- entities that are in-out actuals, the read reference follows
+ -- the modify reference.
- else
- return T2.Key.Typ = 'r';
+ else
+ return T2.Key.Typ = 'r';
+ end if;
end if;
end Lt;
Parent_Installed : Boolean := False;
Renaming_List : List_Id;
- Save_Style_Check : constant Boolean := Style_Check;
- -- Save style check mode for restore on exit
-
procedure Analyze_Instance_And_Renamings;
-- The instance must be analyzed in a context that includes the mappings
-- of generic parameters into actuals. We create a package declaration
Instantiation_Node := N;
- -- Turn off style checking in instances. If the check is enabled on the
- -- generic unit, a warning in an instance would just be noise. If not
- -- enabled on the generic, then a warning in an instance is just wrong.
+ -- For package instantiations we turn off style checks, because they
+ -- will have been emitted in the generic. For subprogram instantiations
+ -- we want to apply at least the check on overriding indicators so we
+ -- do not modify the style check status.
- Style_Check := False;
+ -- The renaming declarations for the actuals do not come from source and
+ -- will not generate spurious warnings.
Preanalyze_Actuals (N);
Generic_Renamings_HTable.Reset;
end if;
- Style_Check := Save_Style_Check;
-
<<Leave>>
if Has_Aspects (N) then
Analyze_Aspect_Specifications (N, Act_Decl_Id);
if Env_Installed then
Restore_Env;
end if;
-
- Style_Check := Save_Style_Check;
end Analyze_Subprogram_Instantiation;
-------------------------
-- that an invariant check is required (for an IN OUT parameter, or
-- the returned value of a function.
+ function Last_Implicit_Declaration return Node_Id;
+ -- Return the last internally-generated declaration of N
+
-------------
-- Grab_CC --
-------------
end if;
end Is_Public_Subprogram_For;
+ -------------------------------
+ -- Last_Implicit_Declaration --
+ -------------------------------
+
+ function Last_Implicit_Declaration return Node_Id is
+ Loc : constant Source_Ptr := Sloc (N);
+ Decls : List_Id := Declarations (N);
+ Decl : Node_Id;
+ Succ : Node_Id;
+
+ begin
+ if No (Decls) then
+ Decls := New_List (Make_Null_Statement (Loc));
+ Set_Declarations (N, Decls);
+
+ elsif Is_Empty_List (Declarations (N)) then
+ Append_To (Decls, Make_Null_Statement (Loc));
+ end if;
+
+ -- Implicit and source declarations may be interspersed. Search for
+ -- the last implicit declaration which is either succeeded by a
+ -- source construct or is the last node in the declarative list.
+
+ Decl := First (Declarations (N));
+ while Present (Decl) loop
+ Succ := Next (Decl);
+
+ -- The current declaration is the last one, do not return Empty
+
+ if No (Succ) then
+ exit;
+
+ -- The successor is a source construct
+
+ elsif Comes_From_Source (Succ) then
+ exit;
+ end if;
+
+ Next (Decl);
+ end loop;
+
+ return Decl;
+ end Last_Implicit_Declaration;
+
-- Start of processing for Process_PPCs
begin
-- The entity for the _Postconditions procedure
begin
- Prepend_To (Declarations (N),
+ Insert_After (Last_Implicit_Declaration,
Make_Subprogram_Body (Loc,
Specification =>
Make_Procedure_Specification (Loc,
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
procedure Missing_Overriding (N : Node_Id; E : Entity_Id) is
begin
- if Style_Check_Missing_Overriding and then Comes_From_Source (N) then
+
+ -- Perform the check on source subprograms and on subprogram instances,
+ -- because these can be primitives of untagged types.
+
+ if Style_Check_Missing_Overriding
+ and then (Comes_From_Source (N) or else Is_Generic_Instance (E))
+ then
if Nkind (N) = N_Subprogram_Body then
Error_Msg_NE -- CODEFIX
("(style) missing OVERRIDING indicator in body of&", N, E);
projects / platform / upstream / linaro-gcc.git / commitdiff