2010-10-18 Ed Schonberg <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): If subprogram is at the
	library level, the pre/postconditions must be treated as global
	declarations, i.e. placed on the Aux_Decl nodes of the compilation unit.
	* freeze.adb (Freeze_Expression): If the expression is at library level
	there is no enclosing record to check.

2010-10-18  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.ads (Find_Type_Name): Add documentation.
	* sem_ch3.adb (Analyze_Full_Type_Declaration): Code cleanup because the
	propagation of the class-wide entity is now done by routine
	Find_Type_Name to factorize this code.
	(Analyze_Private_Extension_Declaration): Handle private type that
	completes an incomplete type.
	(Tag_Mismatch): Add error message for tag mismatch in a private type
	declaration that completes an incomplete type.
	(Find_Type_Name): Handle completion of incomplete type by means of
	a private declaration. Generate an error if a tagged incomplete type
	is completed by an untagged private type.
	* sem_ch7.adb (New_Private_Type): Handle private type that completes an
	incomplete type.
	* einfo.ads (Full_View): Add documentation.

2010-10-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Analyze_Formal_Package_Declaration): If the package is
	a renaming, generate a reference for it before analyzing the renamed
	entity, to prevent spurious warnings.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165636 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 187 insertions, 39 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 847bef2b532..057e3d1f2a2 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,34 @@
+2010-10-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Analyze_Aspect_Specifications): If subprogram is at the
+	library level, the pre/postconditions must be treated as global
+	declarations, i.e. placed on the Aux_Decl nodes of the compilation unit.
+	* freeze.adb (Freeze_Expression): If the expression is at library level
+	there is no enclosing record to check.
+
+2010-10-18  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch3.ads (Find_Type_Name): Add documentation.
+	* sem_ch3.adb (Analyze_Full_Type_Declaration): Code cleanup because the
+	propagation of the class-wide entity is now done by routine
+	Find_Type_Name to factorize this code.
+	(Analyze_Private_Extension_Declaration): Handle private type that
+	completes an incomplete type.
+	(Tag_Mismatch): Add error message for tag mismatch in a private type
+	declaration that completes an incomplete type.
+	(Find_Type_Name): Handle completion of incomplete type by means of
+	a private declaration. Generate an error if a tagged incomplete type
+	is completed by an untagged private type.
+	* sem_ch7.adb (New_Private_Type): Handle private type that completes an
+	incomplete type.
+	* einfo.ads (Full_View): Add documentation.
+
+2010-10-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Analyze_Formal_Package_Declaration): If the package is
+	a renaming, generate a reference for it before analyzing the renamed
+	entity, to prevent spurious warnings.
+
 2010-10-18  Jose Ruiz  <ruiz@adacore.com>
 
 	* adaint.c (__gnat_pthread_setaffinity_np,
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index f32ade5f170..7a39892bc84 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1283,7 +1283,10 @@ package Einfo is
 --       Present in all type and subtype entities and in deferred constants.
 --       References the entity for the corresponding full type declaration.
 --       For all types other than private and incomplete types, this field
---       always contains Empty. See also Underlying_Type.
+--       always contains Empty. If an incomplete type E1 is completed by a
+--       private type E2 whose full type declaration entity is E3 then the
+--       full view of E1 is E2, and the full view of E2 is E3. See also
+--       Underlying_Type.
 
 --    Generic_Homonym (Node11)
 --       Present in generic packages. The generic homonym is the entity of
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 91e984386f2..ca73e8674f1 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4570,8 +4570,12 @@ package body Freeze is
             --  The current scope may be that of a constrained component of
             --  an enclosing record declaration, which is above the current
             --  scope in the scope stack.
+            --  If the expression is within a top-level pragma, as for a pre-
+            --  condition on a library-level subprogram, nothing to do.
 
-            if Is_Record_Type (Scope (Current_Scope)) then
+            if not Is_Compilation_Unit (Current_Scope)
+              and then Is_Record_Type (Scope (Current_Scope))
+            then
                Pos := Pos - 1;
             end if;
 
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index c139cf963ad..45b61bbb0e4 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -2112,6 +2112,15 @@ package body Sem_Ch12 is
       --  Check for a formal package that is a package renaming
 
       if Present (Renamed_Object (Gen_Unit)) then
+
+         --  Indicate that unit is used, before replacing it with renamed
+         --  entity for use below.
+
+         if In_Extended_Main_Source_Unit (N) then
+            Set_Is_Instantiated (Gen_Unit);
+            Generate_Reference  (Gen_Unit, N);
+         end if;
+
          Gen_Unit := Renamed_Object (Gen_Unit);
       end if;
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8966e151b0f..2132e3c3259 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -995,11 +995,19 @@ package body Sem_Ch13 is
                   --  about delay issues, since the pragmas themselves deal
                   --  with delay of visibility for the expression analysis.
 
-                  Insert_After (N, Aitem);
+                  --  If the entity is a library-level subprogram, the pre/
+                  --  postconditions must be treated as late pragmas.
+
+                  if Nkind (Parent (N)) = N_Compilation_Unit then
+                     Add_Global_Declaration (Aitem);
+                  else
+                     Insert_After (N, Aitem);
+                  end if;
+
                   goto Continue;
                end;
 
-               --  Aspects currently unimplemented
+                  --  Aspects currently unimplemented
 
                when Aspect_Invariant |
                     Aspect_Predicate =>
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index a17ab5321c3..a54393ac915 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2171,24 +2171,10 @@ package body Sem_Ch3 is
       --  imported through a LIMITED WITH clause, it appears as incomplete
       --  but has no full view.
 
-      --  If the incomplete view is tagged, a class_wide type has been
-      --  created already. Use it for the full view as well, to prevent
-      --  multiple incompatible class-wide types that may be  created for
-      --  self-referential anonymous access components.
-
       if Ekind (Prev) = E_Incomplete_Type
         and then Present (Full_View (Prev))
       then
          T := Full_View (Prev);
-
-         if Is_Tagged_Type (Prev)
-           and then Present (Class_Wide_Type (Prev))
-         then
-            Set_Ekind (T, Ekind (Prev));         --  will be reset later
-            Set_Class_Wide_Type (T, Class_Wide_Type (Prev));
-            Set_Etype (Class_Wide_Type (T), T);
-         end if;
-
       else
          T := Prev;
       end if;
@@ -3605,7 +3591,26 @@ package body Sem_Ch3 is
       end if;
 
       Generate_Definition (T);
-      Enter_Name (T);
+
+      if Ada_Version < Ada_2012 then
+         Enter_Name (T);
+
+      --  Ada 2012 (AI05-0162): Enter the name in the current scope handling
+      --  case of private type that completes an incomplete type.
+
+      else
+         declare
+            Prev : Entity_Id;
+
+         begin
+            Prev := Find_Type_Name (N);
+
+            pragma Assert (Prev = T
+              or else (Ekind (Prev) = E_Incomplete_Type
+                         and then Present (Full_View (Prev))
+                         and then Full_View (Prev) = T));
+         end;
+      end if;
 
       Parent_Type := Find_Type_Of_Subtype_Indic (Indic);
       Parent_Base := Base_Type (Parent_Type);
@@ -14085,11 +14090,25 @@ package body Sem_Ch3 is
       procedure Tag_Mismatch is
       begin
          if Sloc (Prev) < Sloc (Id) then
-            Error_Msg_NE
-              ("full declaration of } must be a tagged type ", Id, Prev);
+            if Ada_Version >= Ada_2012
+              and then Nkind (N) = N_Private_Type_Declaration
+            then
+               Error_Msg_NE
+                 ("declaration of private } must be a tagged type ", Id, Prev);
+            else
+               Error_Msg_NE
+                 ("full declaration of } must be a tagged type ", Id, Prev);
+            end if;
          else
-            Error_Msg_NE
-              ("full declaration of } must be a tagged type ", Prev, Id);
+            if Ada_Version >= Ada_2012
+              and then Nkind (N) = N_Private_Type_Declaration
+            then
+               Error_Msg_NE
+                 ("declaration of private } must be a tagged type ", Prev, Id);
+            else
+               Error_Msg_NE
+                 ("full declaration of } must be a tagged type ", Prev, Id);
+            end if;
          end if;
       end Tag_Mismatch;
 
@@ -14100,21 +14119,35 @@ package body Sem_Ch3 is
 
       Prev := Current_Entity_In_Scope (Id);
 
-      if Present (Prev) then
+      --  New type declaration
+
+      if No (Prev) then
+         Enter_Name (Id);
+         return Id;
 
-         --  Previous declaration exists. Error if not incomplete/private case
-         --  except if previous declaration is implicit, etc. Enter_Name will
-         --  emit error if appropriate.
+      --  Previous declaration exists
 
+      else
          Prev_Par := Parent (Prev);
 
+         --  Error if not incomplete/private case except if previous
+         --  declaration is implicit, etc. Enter_Name will emit error if
+         --  appropriate.
+
          if not Is_Incomplete_Or_Private_Type (Prev) then
             Enter_Name (Id);
             New_Id := Id;
 
+         --  Check invalid completion of private or incomplete type
+
          elsif not Nkind_In (N, N_Full_Type_Declaration,
                                 N_Task_Type_Declaration,
                                 N_Protected_Type_Declaration)
+           and then
+             (Ada_Version < Ada_2012
+                or else not Is_Incomplete_Type (Prev)
+                or else not Nkind_In (N, N_Private_Type_Declaration,
+                                         N_Private_Extension_Declaration))
          then
             --  Completion must be a full type declarations (RM 7.3(4))
 
@@ -14136,7 +14169,11 @@ package body Sem_Ch3 is
 
          --  Case of full declaration of incomplete type
 
-         elsif Ekind (Prev) = E_Incomplete_Type then
+         elsif Ekind (Prev) = E_Incomplete_Type
+           and then (Ada_Version < Ada_2012
+                       or else No (Full_View (Prev))
+                       or else not Is_Private_Type (Full_View (Prev)))
+         then
 
             --  Indicate that the incomplete declaration has a matching full
             --  declaration. The defining occurrence of the incomplete
@@ -14153,9 +14190,34 @@ package body Sem_Ch3 is
             Set_Is_Internal (Id);
             New_Id := Prev;
 
+            --  If the incomplete view is tagged, a class_wide type has been
+            --  created already. Use it for the private type as well, in order
+            --  to prevent multiple incompatible class-wide types that may be
+            --  created for self-referential anonymous access components.
+
+            if Is_Tagged_Type (Prev)
+              and then Present (Class_Wide_Type (Prev))
+            then
+               Set_Ekind (Id, Ekind (Prev));         --  will be reset later
+               Set_Class_Wide_Type (Id, Class_Wide_Type (Prev));
+               Set_Etype (Class_Wide_Type (Id), Id);
+            end if;
+
          --  Case of full declaration of private type
 
          else
+            --  If the private type was a completion of an incomplete type then
+            --  update Prev to reference the private type
+
+            if Ada_Version >= Ada_2012
+              and then Ekind (Prev) = E_Incomplete_Type
+              and then Present (Full_View (Prev))
+              and then Is_Private_Type (Full_View (Prev))
+            then
+               Prev := Full_View (Prev);
+               Prev_Par := Parent (Prev);
+            end if;
+
             if Nkind (Parent (Prev)) /= N_Private_Extension_Declaration then
                if Etype (Prev) /= Prev then
 
@@ -14273,14 +14335,30 @@ package body Sem_Ch3 is
 
          if Is_Type (Prev)
            and then (Is_Tagged_Type (Prev)
-                      or else Present (Class_Wide_Type (Prev)))
+                       or else Present (Class_Wide_Type (Prev)))
          then
+            --  Ada 2012 (AI05-0162): A private type may be the completion of
+            --  an incomplete type
+
+            if Ada_Version >= Ada_2012
+              and then Is_Incomplete_Type (Prev)
+              and then Nkind_In (N, N_Private_Type_Declaration,
+                                    N_Private_Extension_Declaration)
+            then
+               --  No need to check private extensions since they are tagged
+
+               if Nkind (N) = N_Private_Type_Declaration
+                 and then not Tagged_Present (N)
+               then
+                  Tag_Mismatch;
+               end if;
+
             --  The full declaration is either a tagged type (including
             --  a synchronized type that implements interfaces) or a
             --  type extension, otherwise this is an error.
 
-            if Nkind_In (N, N_Task_Type_Declaration,
-                            N_Protected_Type_Declaration)
+            elsif Nkind_In (N, N_Task_Type_Declaration,
+                               N_Protected_Type_Declaration)
             then
                if No (Interface_List (N))
                  and then not Error_Posted (N)
@@ -14315,12 +14393,6 @@ package body Sem_Ch3 is
          end if;
 
          return New_Id;
-
-      else
-         --  New type declaration
-
-         Enter_Name (Id);
-         return Id;
       end if;
    end Find_Type_Name;
 
diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads
index 2bff2e2bbd9..57da53272fa 100644
--- a/gcc/ada/sem_ch3.ads
+++ b/gcc/ada/sem_ch3.ads
@@ -157,7 +157,10 @@ package Sem_Ch3 is
    function Find_Type_Name (N : Node_Id) return Entity_Id;
    --  Enter the identifier in a type definition, or find the entity already
    --  declared, in the case of the full declaration of an incomplete or
-   --  private type.
+   --  private type. If the previous declaration is tagged then the class-wide
+   --  entity is propagated to the identifier to prevent multiple incompatible
+   --  class-wide types that may be created for self-referential anonymous
+   --  access components.
 
    function Get_Discriminant_Value
      (Discriminant       : Entity_Id;
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 08d68bfb073..108b15819c2 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1919,7 +1919,25 @@ package body Sem_Ch7 is
 
    procedure New_Private_Type (N : Node_Id; Id : Entity_Id; Def : Node_Id) is
    begin
-      Enter_Name (Id);
+      if Ada_Version < Ada_2012 then
+         Enter_Name (Id);
+
+      --  Ada 2012 (AI05-0162): Enter the name in the current scope handling
+      --  private type that completes an incomplete type.
+
+      else
+         declare
+            Prev : Entity_Id;
+
+         begin
+            Prev := Find_Type_Name (N);
+
+            pragma Assert (Prev = Id
+              or else (Ekind (Prev) = E_Incomplete_Type
+                         and then Present (Full_View (Prev))
+                         and then Full_View (Prev) = Id));
+         end;
+      end if;
 
       if Limited_Present (Def) then
          Set_Ekind (Id, E_Limited_Private_Type);