[multiple changes]

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.

From-SVN: r186070

gcc/ada/ChangeLog

@@ -1,3 +1,23 @@
+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

gcc/ada/lib-xref-alfa.adb

@@ -570,67 +570,68 @@ package body Alfa is
          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 ???
-
-         elsif T1.Key.Ent /= T2.Key.Ent then
-            raise Program_Error;
-
-         --  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;
-
-         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.
-
-         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;
-
-         --  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);
-
-         --  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);
-
-         --  Eighth test: order of location within referencing unit
-
-         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.
-
          else
-            return T2.Key.Typ = 'r';
+            --  Both entities must be equal at this point
+
+            pragma Assert (T1.Key.Ent = T2.Key.Ent);
+
+            --  Fourth test: if reference is in same unit as entity definition,
+            --  sort first.
+
+            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;
+
+            --  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 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
+
+            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
+
+            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
+
+            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.
+
+            else
+               return T2.Key.Typ = 'r';
+            end if;
          end if;
       end Lt;
 

gcc/ada/sem_ch12.adb

@@ -4404,9 +4404,6 @@ package body Sem_Ch12 is
       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
@@ -4587,11 +4584,13 @@ package body Sem_Ch12 is
 
       Instantiation_Node := N;
 
-      --  Turn off style checking in instances. If the check is enabled on the
+      --  For package instantiations we turn off style checks, because they
-      --  generic unit, a warning in an instance would just be noise. If not
+      --  will have been emitted in the generic. For subprogram instantiations
-      --  enabled on the generic, then a warning in an instance is just wrong.
+      --  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);
 
@@ -4859,8 +4858,6 @@ package body Sem_Ch12 is
          Generic_Renamings_HTable.Reset;
       end if;
 
-      Style_Check := Save_Style_Check;
-
    <<Leave>>
       if Has_Aspects (N) then
          Analyze_Aspect_Specifications (N, Act_Decl_Id);
@@ -4875,8 +4872,6 @@ package body Sem_Ch12 is
          if Env_Installed then
             Restore_Env;
          end if;
-
-         Style_Check := Save_Style_Check;
    end Analyze_Subprogram_Instantiation;
 
    -------------------------

gcc/ada/sem_ch6.adb

@@ -11057,6 +11057,9 @@ package body Sem_Ch6 is
       --  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 --
       -------------
@@ -11307,6 +11310,50 @@ package body Sem_Ch6 is
          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
@@ -11712,7 +11759,7 @@ package body Sem_Ch6 is
             --  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,

gcc/ada/style.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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- --
@@ -236,7 +236,13 @@ package body Style is
 
    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);